Merge branch 'main' into shaders

This commit is contained in:
龙腾猫跃
2025-04-28 02:39:20 +08:00
committed by GitHub
140 changed files with 11887 additions and 5676 deletions
+1 -1
View File
@@ -1,6 +1,6 @@
name: "Minecraft 崩溃" name: "Minecraft 崩溃"
description: "PCL 提示 “Minecraft 出现错误”,或游戏崩溃" description: "PCL 提示 “Minecraft 出现错误”,或游戏崩溃"
labels: [· Bug, 新反馈] labels: [· Bug, 新提交]
body: body:
- type: checkboxes - type: checkboxes
id: "yml-1" id: "yml-1"
+1 -1
View File
@@ -1,6 +1,6 @@
name: "下载或登录时卡住或失败" name: "下载或登录时卡住或失败"
description: "下载游戏、Mod 或整合包,或登录正版账号时出现问题" description: "下载游戏、Mod 或整合包,或登录正版账号时出现问题"
labels: [· Bug, 新反馈] labels: [· Bug, 新提交]
body: body:
- type: checkboxes - type: checkboxes
id: "yml-1" id: "yml-1"
+1 -1
View File
@@ -1,6 +1,6 @@
name: "综合 Bug 反馈" name: "综合 Bug 反馈"
description: "遇见了没有细分选项的其他 Bug" description: "遇见了没有细分选项的其他 Bug"
labels: [· Bug, 新反馈] labels: [· Bug, 新提交]
body: body:
- type: checkboxes - type: checkboxes
id: "yml-1" id: "yml-1"
+1 -1
View File
@@ -1,6 +1,6 @@
name: "优化建议" name: "优化建议"
description: "对已有功能的小幅度优化或改进建议" description: "对已有功能的小幅度优化或改进建议"
labels: [· 优化, 新反馈] labels: [· 优化, 新提交]
body: body:
- type: checkboxes - type: checkboxes
id: "yml-1" id: "yml-1"
+3
View File
@@ -1,5 +1,8 @@
blank_issues_enabled: false blank_issues_enabled: false
contact_links: contact_links:
- name: 主页预设反馈
url: https://github.com/Hex-Dragon/PCL2/discussions/categories/自定义主页
about: 提交与预设的主页(设置 → 个性化 → 主页预设)中的具体内容相关的反馈
- name: 帮助文档反馈 - name: 帮助文档反馈
url: https://github.com/LTCatt/PCL2Help/issues url: https://github.com/LTCatt/PCL2Help/issues
about: 提交与 PCL 帮助文档(更多 → 帮助)中的具体内容相关的反馈 about: 提交与 PCL 帮助文档(更多 → 帮助)中的具体内容相关的反馈
+1 -1
View File
@@ -1,6 +1,6 @@
name: "新功能提案" name: "新功能提案"
description: "对已有功能的大幅度修改,或添加一个新内容或选项" description: "对已有功能的大幅度修改,或添加一个新内容或选项"
labels: [· 新功能, 新反馈] labels: [· 新功能, 新提交]
body: body:
- type: checkboxes - type: checkboxes
id: "yml-1" id: "yml-1"
+28 -10
View File
@@ -1,5 +1,4 @@
name: Build name: Build
on: on:
push: push:
paths: paths:
@@ -12,16 +11,15 @@ on:
workflow_dispatch: workflow_dispatch:
jobs: jobs:
build: build:
name: Build
strategy:
matrix:
configuration: [Debug, Release, Snapshot, BETA, ReleaseUpdate]
runs-on: windows-latest runs-on: windows-latest
strategy:
matrix:
configuration: [Debug, Release]
steps: steps:
- name: Checkout - name: Checkout
uses: actions/checkout@v4 uses: actions/checkout@v4
with: with:
@@ -30,19 +28,39 @@ jobs:
- name: Set Describe - name: Set Describe
shell: bash shell: bash
run: | run: |
Describe=`git describe --tags --always` describe=`git describe --tags --always`
echo "Describe=$Describe" >> $GITHUB_ENV echo "describe=$describe" >> $GITHUB_ENV
- name: Setup MSBuild.exe - name: Setup MSBuild.exe
uses: microsoft/setup-msbuild@v2 uses: microsoft/setup-msbuild@v2
with: with:
msbuild-architecture: x64 msbuild-architecture: x64
- name: Update Help
run: |
$workpath = [System.Environment]::CurrentDirectory
Set-Location ..
git clone https://github.com/LTCatt/PCL2Help.git -b master --single-branch --depth 1
Set-Location PCL2Help
Remove-Item -Path *.* -Recurse -Force
Compress-Archive -Path .\* -DestinationPath .\Help.zip
Copy-Item -Path .\Help.zip -Destination "${{ GITHUB.WORKSPACE }}\Plain Craft Launcher 2\Resources\Help.zip" -Force
Set-Location ..
Remove-Item PCL2Help -Recurse -Force
Set-Location ${{ GITHUB.WORKSPACE }}
- name: Replace
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 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\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
run: msbuild "Plain Craft Launcher 2\Plain Craft Launcher 2.vbproj" -p:Configuration=${{ matrix.configuration }} run: msbuild "Plain Craft Launcher 2\Plain Craft Launcher 2.vbproj" -p:Configuration=${{ matrix.configuration }}
- name: Upload a Build Artifact - name: Upload a Build Artifact
uses: actions/upload-artifact@v4 uses: actions/upload-artifact@v4
with: with:
name: ${{ matrix.configuration }} ${{ env.Describe }} name: ${{ matrix.configuration }} ${{ env.describe }}
path: Plain Craft Launcher 2\obj\${{ matrix.configuration }}\Plain Craft Launcher 2.exe path: Plain Craft Launcher 2\obj\${{ matrix.configuration }}\Plain Craft Launcher 2.exe
+35 -18
View File
@@ -1,25 +1,40 @@
本文件仅作为指引您合理使用本存储库内容的指南,不是法律文件或协议。 一、声明
一、承诺与声明。 本文件仅作为指南,不是法律文件或协议。但开发者在此承诺,在您遵守本指南且善意、合理使用的情况下,不会追究您的责任。
法律上,开发者仍保留所有权利(All Rights Reserved),若情况恶劣,仍可能将诉讼作为最终手段。
  开发者承诺,在您遵守本指南的情况下,不会追究您的责任,但最终裁量权仍由开发者保留。
  法律上,开发者仍保留所有权利(All Rights Reserved),且可能随时修改本指南,本指南并不是永久性保证。
二、少量使用情形。
  如果您仅合理使用本存储库中的少量内容,或是参考实现思路,您必须: 二、轻度使用
  1、给出适当的署名,且提供指向本存储库的链接。
  2、不得以任何方式暗示开发者为您或您的使用作担保。
三、大量使用情形。 若您仅参考了本存储库中极小部分的内容,或您在制作与 PCL 的实质功能不存在任何重叠的软件,则为轻度使用。
其常见情形例如:
· 使用或参考存储库中极小部分的内容,来开发启动器或其他软件。
· 虽参考了较大量的内容,但制作的软件与 PCL 的实质功能不存在任何重叠。
  如果您基于该存储库创作衍生作品,或合理使用了本存储库中的较大量内容,您必须: 若属于轻度使用,您需要:
  1、给出适当的署名,且提供指向本存储库的链接。GitHub 上的 Fork 可视为满足此条。 1、以适当的形式给出署名。
  2、不得以任何方式暗示开发者为您或您的使用作担保,且需要给出适当的说明,表示这是非官方内容。 2、不得将您的内容与 PCL 混淆,或暗示您的内容与 PCL 有关。
  3、使用本指南文件作为协议,不得附加额外条款。  例如:您的内容不得使用 Planting Craft Launcher、PCL 手机版 等会造成混淆或暗示这与 PCL 有关的名称。
  4、该衍生作品不能被允许用于再次分发。包括但不限于用于制作整合包。
  5、该衍生作品的名称必须以 “PCL” 或 “Plain Craft Launcher” 开头,并在其后添加后缀,例如 “PCL 启动修复版”、“PCL PR Collection”。
  6、该衍生作品不得包含 PCL 的赞助功能,或是其他作用相似的功能。包括但不限于主题功能、回声洞投稿功能等。
三、重度使用
若不符合轻度使用的情形,即为重度使用。
其常见情形例如:
· 基于本存储库进行修改。
· 参考存储库中较大量的内容,以制作或重新实现 PCL 的部分实质功能(例如启动或下载 Java 版 Minecraft,下载或管理 Mod 等)。
若属于重度使用,您需要:
1、明确表示您的内容是第三方基于 PCL 独立进行二次创作的产物。
2、您的内容的名称必须以 Plain Craft Launcher (PCL) 开头,并在其后添加足以表现其由第三方修改的后缀。
 允许的示例:PCL 某服务器魔改版、PCL PR Collection、PCL (XX Bug Fix)、PCL XXX修改版。
 禁止的示例:PCL 某服务器特供版(暗示由官方提供)、PCL 3、PCL 手机版、PCL++、PCL Pro(这像是官方的后续作品)。
3、在关于页面的首位给出龙腾猫跃的署名及对应的赞助链接,公开源代码,且继续使用本文件作为指南(可参考 CC BY-SC 协议)。
4、软件若有 Minecraft 启动功能,则应实现与 McLaunchPrecheck 函数一致的 Minecraft 正版购买弹窗与赞助弹窗。
5、软件在 Windows 系统上运行时,不应有与 PCL 的赞助解锁功能类似的功能或表现。
 例如:界面的主要色相必须为蓝色(即使没有修改功能,改为其他色相也和需要赞助解锁的主题功能类似)。
———————————— ————————————
@@ -28,5 +43,7 @@
因为没有法律专业人士检查,所以这不敢作为正式的法律协议,如果有专业人士愿意帮忙改一改我也很乐意…… 因为没有法律专业人士检查,所以这不敢作为正式的法律协议,如果有专业人士愿意帮忙改一改我也很乐意……
这些规则主要是为了阻止恶意的使用和 “山寨版” 的出现,常规、善意的使用都没啥问题的,放心吧! 这些规则主要是为了阻止恶意的使用和 “山寨版” 的出现,常规、善意的使用都没啥问题的,放心吧!
如果你只是想参考一下,或者用了一小部分代码,署个名就行啦。 如果你只是参考了一小段代码,署个名就行啦,不用担心。
如果你整了个魔改版,或者用了一大堆代码,请仔细参考上面的第三条。 如果对具体细节有疑问,欢迎在 https://github.com/Hex-Dragon/PCL2/discussions/new?category=%E6%8F%90%E9%97%AE 发帖询问!
多谢大家啦!
+29 -27
View File
@@ -1,33 +1,35 @@
<?xml version="1.0" encoding="utf-8"?> <?xml version="1.0" encoding="utf-8"?>
<configuration> <configuration>
<system.net> <system.net>
<settings> <settings>
<httpWebRequest useUnsafeHeaderParsing="true"/> <httpWebRequest useUnsafeHeaderParsing="true"/>
</settings> </settings>
</system.net> </system.net>
<startup> <startup>
<supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.6.2"/> <supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.6.2"/>
</startup> </startup>
<runtime> <runtime>
<AppContextSwitchOverrides value="Switch.System.Net.DontEnableSchUseStrongCrypto=false" /> <AppContextSwitchOverrides value="Switch.System.Net.DontEnableSchUseStrongCrypto=false" />
<generatePublisherEvidence enabled="false"/> <AppContextSwitchOverrides value="Switch.System.Windows.DoNotScaleForDpiChanges=false"/> <!-- #5337 -->
<assemblyBinding xmlns="urn:schemas-microsoft-com:asm.v1"> <AppContextSwitchOverrides value="Switch.System.IO.UseLegacyPathHandling=false;Switch.System.IO.BlockLongPaths=false" /> <!-- 长路径支持 -->
<dependentAssembly> <generatePublisherEvidence enabled="false"/>
<assemblyIdentity name="System.Numerics.Vectors" publicKeyToken="b03f5f7f11d50a3a" culture="neutral"/> <assemblyBinding xmlns="urn:schemas-microsoft-com:asm.v1">
<bindingRedirect oldVersion="0.0.0.0-4.1.4.0" newVersion="4.1.4.0"/> <dependentAssembly>
</dependentAssembly> <assemblyIdentity name="System.Numerics.Vectors" publicKeyToken="b03f5f7f11d50a3a" culture="neutral"/>
<dependentAssembly> <bindingRedirect oldVersion="0.0.0.0-4.1.4.0" newVersion="4.1.4.0"/>
<assemblyIdentity name="System.Runtime.CompilerServices.Unsafe" publicKeyToken="b03f5f7f11d50a3a" culture="neutral"/> </dependentAssembly>
<bindingRedirect oldVersion="0.0.0.0-4.0.6.0" newVersion="4.0.6.0"/> <dependentAssembly>
</dependentAssembly> <assemblyIdentity name="System.Runtime.CompilerServices.Unsafe" publicKeyToken="b03f5f7f11d50a3a" culture="neutral"/>
<dependentAssembly> <bindingRedirect oldVersion="0.0.0.0-4.0.6.0" newVersion="4.0.6.0"/>
<assemblyIdentity name="System.Buffers" publicKeyToken="cc7b13ffcd2ddd51" culture="neutral"/> </dependentAssembly>
<bindingRedirect oldVersion="0.0.0.0-4.0.3.0" newVersion="4.0.3.0"/> <dependentAssembly>
</dependentAssembly> <assemblyIdentity name="System.Buffers" publicKeyToken="cc7b13ffcd2ddd51" culture="neutral"/>
<dependentAssembly> <bindingRedirect oldVersion="0.0.0.0-4.0.3.0" newVersion="4.0.3.0"/>
<assemblyIdentity name="System.ValueTuple" publicKeyToken="cc7b13ffcd2ddd51" culture="neutral"/> </dependentAssembly>
<bindingRedirect oldVersion="0.0.0.0-4.0.3.0" newVersion="4.0.3.0"/> <dependentAssembly>
</dependentAssembly> <assemblyIdentity name="System.ValueTuple" publicKeyToken="cc7b13ffcd2ddd51" culture="neutral"/>
</assemblyBinding> <bindingRedirect oldVersion="0.0.0.0-4.0.3.0" newVersion="4.0.3.0"/>
</runtime> </dependentAssembly>
</assemblyBinding>
</runtime>
</configuration> </configuration>
+11 -4
View File
@@ -14,6 +14,13 @@
<ResourceDictionary Source="pack://application:,,,/Resources/Language/zh_CN.xaml" /> <ResourceDictionary Source="pack://application:,,,/Resources/Language/zh_CN.xaml" />
</ResourceDictionary.MergedDictionaries> </ResourceDictionary.MergedDictionaries>
<!-- Converter -->
<local:AdditionConverter x:Key="AdditionConverter"/>
<local:MultiplicationConverter x:Key="MultiplicationConverter"/>
<local:InverseBooleanToVisibilityConverter x:Key="InverseBooleanToVisibilityConverter"/>
<local:InverseBooleanConverter x:Key="InverseBooleanConverter"/>
<BooleanToVisibilityConverter x:Key="BooleanToVisibilityConverter"/>
<!-- 颜色表 --> <!-- 颜色表 -->
<SolidColorBrush x:Key="ColorBrush1">#343d4a</SolidColorBrush> <SolidColorBrush x:Key="ColorBrush1">#343d4a</SolidColorBrush>
<SolidColorBrush x:Key="ColorBrush2">#0b5bcb</SolidColorBrush> <SolidColorBrush x:Key="ColorBrush2">#0b5bcb</SolidColorBrush>
@@ -281,21 +288,21 @@
<Setter Property="BorderBrush" Value="{DynamicResource ColorBrushBg0}" /> <Setter Property="BorderBrush" Value="{DynamicResource ColorBrushBg0}" />
<Setter Property="Template"> <Setter Property="Template">
<Setter.Value> <Setter.Value>
<ControlTemplate TargetType="TextBox"> <ControlTemplate TargetType="local:MyTextBox">
<Grid SnapsToDevicePixels="True" ToolTip="{TemplateBinding ToolTip}"> <Grid SnapsToDevicePixels="True" ToolTip="{TemplateBinding ToolTip}">
<Grid.RowDefinitions> <Grid.RowDefinitions>
<RowDefinition MinHeight="28" /> <RowDefinition MinHeight="28" />
<RowDefinition Height="Auto" /> <RowDefinition Height="Auto" />
</Grid.RowDefinitions> </Grid.RowDefinitions>
<Border x:Name="border" BorderThickness="{TemplateBinding BorderThickness}" BorderBrush="{TemplateBinding BorderBrush}" Background="{TemplateBinding Background}" CornerRadius="3"> <Border x:Name="border" BorderThickness="{TemplateBinding BorderThickness}" BorderBrush="{TemplateBinding BorderBrush}" Background="{TemplateBinding Background}" CornerRadius="{TemplateBinding CornerRadius}">
<ScrollViewer x:Name="PART_ContentHost" Style="{StaticResource ScrollViewerNoMargin}" RenderOptions.ClearTypeHint="Enabled" BorderThickness="0" <ScrollViewer x:Name="PART_ContentHost" Style="{StaticResource ScrollViewerNoMargin}" RenderOptions.ClearTypeHint="Enabled" BorderThickness="0"
Margin="5,0,0,0" Cursor="IBeam" /> Margin="5,0,0,0" Cursor="IBeam" />
<!-- 由于未知原因,TextView 会有 2,0 的 Margin --> <!-- 由于未知原因,TextView 会有 2,0 的 Margin -->
</Border> </Border>
<Border Margin="{TemplateBinding Padding}" IsHitTestVisible="False" HorizontalAlignment="{TemplateBinding HorizontalContentAlignment}" VerticalAlignment="{TemplateBinding VerticalContentAlignment}" BorderThickness="0"> <Border Margin="{TemplateBinding Padding}" IsHitTestVisible="False" HorizontalAlignment="{TemplateBinding HorizontalContentAlignment}" VerticalAlignment="{TemplateBinding VerticalContentAlignment}" BorderThickness="0">
<TextBlock x:Name="labHint" Foreground="{DynamicResource ColorBrush1}" Opacity="0.25" Margin="7,0,0,0" Padding="{TemplateBinding BorderThickness}" FontSize="{TemplateBinding FontSize}" FontFamily="Resources/#PCL English, Microsoft YaHei UI" /> <TextBlock x:Name="labHint" Foreground="{StaticResource ColorBrushGray4}" Margin="7,0,0,0" Padding="{TemplateBinding BorderThickness}" FontSize="{TemplateBinding FontSize}" FontFamily="Resources/#PCL English, Microsoft YaHei UI" />
</Border> </Border>
<TextBlock Grid.Row="1" x:Name="labWrong" Height="0" Foreground="{TemplateBinding BorderBrush}" Padding="0,4,0,0" /> <TextBlock Grid.Row="1" x:Name="labWrong" Height="0" Foreground="{TemplateBinding BorderBrush}" Padding="0,4,0,0" Margin="0,0,0,-3" />
</Grid> </Grid>
</ControlTemplate> </ControlTemplate>
</Setter.Value> </Setter.Value>
+43 -27
View File
@@ -1,5 +1,4 @@
Imports System.Net Imports System.Reflection
Imports System.Reflection
Imports System.Windows.Threading Imports System.Windows.Threading
Public Class Application Public Class Application
@@ -26,12 +25,20 @@ Public Class Application
If e.Args(0) = "--update" Then If e.Args(0) = "--update" Then
'自动更新 '自动更新
UpdateReplace(e.Args(1), e.Args(2).Trim(""""), e.Args(3).Trim(""""), e.Args(4)) UpdateReplace(e.Args(1), e.Args(2).Trim(""""), e.Args(3).Trim(""""), e.Args(4))
Environment.Exit(Result.Cancel) Environment.Exit(ProcessReturnValues.TaskDone)
ElseIf e.Args(0) = "--gpu" Then
'调整显卡设置
Try
SetGPUPreference(e.Args(1).Trim(""""))
Environment.Exit(ProcessReturnValues.TaskDone)
Catch ex As Exception
Environment.Exit(ProcessReturnValues.Fail)
End Try
ElseIf e.Args(0).StartsWithF("--memory") Then ElseIf e.Args(0).StartsWithF("--memory") Then
'内存优化 '内存优化
Dim Ram = My.Computer.Info.AvailablePhysicalMemory Dim Ram = My.Computer.Info.AvailablePhysicalMemory
Try Try
PageOtherTest.MemoryOptimizeInternal() PageOtherTest.MemoryOptimizeInternal(False)
Catch ex As Exception Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "内存优化失败") MsgBox(ex.Message, MsgBoxStyle.Critical, "内存优化失败")
Environment.Exit(-1) Environment.Exit(-1)
@@ -45,10 +52,10 @@ Public Class Application
'制作更新包 '制作更新包
ElseIf e.Args(0) = "--edit1" Then ElseIf e.Args(0) = "--edit1" Then
ExeEdit(e.Args(1), True) ExeEdit(e.Args(1), True)
Environment.Exit(Result.Cancel) Environment.Exit(ProcessReturnValues.TaskDone)
ElseIf e.Args(0) = "--edit2" Then ElseIf e.Args(0) = "--edit2" Then
ExeEdit(e.Args(1), False) ExeEdit(e.Args(1), False)
Environment.Exit(Result.Cancel) Environment.Exit(ProcessReturnValues.TaskDone)
#End If #End If
End If End If
End If End If
@@ -72,14 +79,22 @@ Public Class Application
Directory.CreateDirectory(PathAppdata) Directory.CreateDirectory(PathAppdata)
'检测单例 '检测单例
#If Not DEBUG Then #If Not DEBUG Then
Dim ShouldWaitForExit As Boolean = e.Args.Length > 0 AndAlso e.Args(0) = "--wait" '要求等待已有的 PCL 退出
Dim WaitRetryCount As Integer = 0
WaitRetry:
Dim WindowHwnd As IntPtr = FindWindow(Nothing, "Plain Craft Launcher ") Dim WindowHwnd As IntPtr = FindWindow(Nothing, "Plain Craft Launcher ")
If WindowHwnd = IntPtr.Zero Then FindWindow(Nothing, "Plain Craft Launcher 2 ") If WindowHwnd = IntPtr.Zero Then FindWindow(Nothing, "Plain Craft Launcher 2 ")
If WindowHwnd <> IntPtr.Zero Then If WindowHwnd <> IntPtr.Zero Then
If ShouldWaitForExit AndAlso WaitRetryCount < 20 Then '至多等待 10 秒
WaitRetryCount += 1
Thread.Sleep(500)
GoTo WaitRetry
End If
'将已有的 PCL 窗口拖出来 '将已有的 PCL 窗口拖出来
ShowWindowToTop(WindowHwnd) ShowWindowToTop(WindowHwnd)
'播放提示音并退出 '播放提示音并退出
Beep() Beep()
Environment.[Exit](Result.Cancel) Environment.[Exit](ProcessReturnValues.Cancel)
End If End If
#End If #End If
'设置 ToolTipService 默认值 '设置 ToolTipService 默认值
@@ -96,29 +111,27 @@ Public Class Application
End If End If
'动态 DLL 调用 '动态 DLL 调用
AddHandler AppDomain.CurrentDomain.AssemblyResolve, AddressOf AssemblyResolve AddHandler AppDomain.CurrentDomain.AssemblyResolve, AddressOf AssemblyResolve
SetDllDirectory(Path & "PCL\")
If Is32BitSystem Then
File.WriteAllBytes(Path & "PCL\libwebp.dll", GetResources("libwebp32"))
Else
File.WriteAllBytes(Path & "PCL\libwebp.dll", GetResources("libwebp64"))
End If
'日志初始化 '日志初始化
LogStart() LogStart()
'添加日志 '添加日志
Log($"[Start] 程序版本:{VersionDisplayName} ({VersionCode})") Log($"[Start] 程序版本:{VersionDisplayName} ({VersionCode}{If(CommitHash = "", "", $",#{CommitHash}")})")
Log($"[Start] 识别码:{UniqueAddress}{If(ThemeCheckOne(9), ",已解锁反馈主题", "")}") Log($"[Start] 识别码:{UniqueAddress}{If(ThemeCheckOne(9), ",已解锁反馈主题", "")}")
Log($"[Start] 程序路径:{PathWithName}") Log($"[Start] 程序路径:{PathWithName}")
Log($"[Start] 系统编码:{Encoding.Default} ({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 & "请将 PCL 从压缩文件中解压,或是更换文件夹后再继续使用!", "环境警告", "我知道了", IsWarn:=True) MyMsgBox("请将 PCL 从压缩包中解压之后再使用!" & vbCrLf & "在当前环境下运行可能会导致丢失游戏存档或设置,部分功能也可能无法使用!", "环境警告", "我知道了", IsWarn:=True)
End If
If Is32BitSystem Then
MyMsgBox("PCL 和新版 Minecraft 均不再支持 32 位系统,部分功能将无法使用。" & vbCrLf & "非常建议重装为 64 位系统后再进行游戏!", "环境警告", "我知道了", IsWarn:=True)
End If End If
'设置初始化 '设置初始化
Setup.Load("SystemDebugMode") Setup.Load("SystemDebugMode")
Setup.Load("SystemDebugAnim") Setup.Load("SystemDebugAnim")
Setup.Load("ToolDownloadThread") Setup.Load("ToolDownloadThread")
Setup.Load("ToolDownloadCert") Setup.Load("ToolDownloadCert")
Setup.Load("ToolDownloadSpeed")
'网络配置初始化 '网络配置初始化
ServicePointManager.Expect100Continue = True ServicePointManager.Expect100Continue = True
ServicePointManager.SecurityProtocol = SecurityProtocolType.Ssl3 Or SecurityProtocolType.Tls Or SecurityProtocolType.Tls11 Or SecurityProtocolType.Tls12 ServicePointManager.SecurityProtocol = SecurityProtocolType.Ssl3 Or SecurityProtocolType.Tls Or SecurityProtocolType.Tls11 Or SecurityProtocolType.Tls12
@@ -138,7 +151,7 @@ Public Class Application
Catch Catch
End Try End Try
MsgBox(GetExceptionDetail(ex, True) & vbCrLf & "PCL 所在路径:" & If(String.IsNullOrEmpty(FilePath), "获取失败", FilePath), MsgBoxStyle.Critical, "PCL 初始化错误") MsgBox(GetExceptionDetail(ex, True) & vbCrLf & "PCL 所在路径:" & If(String.IsNullOrEmpty(FilePath), "获取失败", FilePath), MsgBoxStyle.Critical, "PCL 初始化错误")
FormMain.EndProgramForce(Result.Exception) FormMain.EndProgramForce(ProcessReturnValues.Exception)
End Try End Try
End Sub End Sub
@@ -155,7 +168,7 @@ Public Class Application
If IsProgramEnded Then Exit Sub If IsProgramEnded Then Exit Sub
If IsCritErrored Then If IsCritErrored Then
'在汇报错误后继续引发错误,知道这次压不住了 '在汇报错误后继续引发错误,知道这次压不住了
FormMain.EndProgramForce(Result.Exception) FormMain.EndProgramForce(ProcessReturnValues.Exception)
Exit Sub Exit Sub
End If End If
IsCritErrored = True IsCritErrored = True
@@ -165,8 +178,8 @@ Public Class Application
ExceptionString.Contains(".NET Framework") OrElse ' “自动错误判断” 的结果分析 ExceptionString.Contains(".NET Framework") OrElse ' “自动错误判断” 的结果分析
ExceptionString.Contains("未能加载文件或程序集") Then ExceptionString.Contains("未能加载文件或程序集") 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")
MsgBox("你的 .NET Framework 版本过低或损坏,请在打开的网页中重新下载并安装 .NET Framework 4.6.2 后重试!", MsgBoxStyle.Information, "运行环境错误") MsgBox("你的 .NET Framework 版本过低或损坏,请下载并重新安装 .NET Framework 4.6.2!", MsgBoxStyle.Information, "运行环境错误")
FormMain.EndProgramForce(Result.Cancel) FormMain.EndProgramForce(ProcessReturnValues.Cancel)
Else Else
FeedbackInfo() FeedbackInfo()
Log(e.Exception, "程序出现未知错误", LogLevel.Assert, "锟斤拷烫烫烫") Log(e.Exception, "程序出现未知错误", LogLevel.Assert, "锟斤拷烫烫烫")
@@ -177,11 +190,12 @@ Public Class Application
Private Shared AssemblyNAudio As Assembly Private Shared AssemblyNAudio As Assembly
Private Shared AssemblyJson As Assembly Private Shared AssemblyJson As Assembly
Private Shared AssemblyDialog As Assembly Private Shared AssemblyDialog As Assembly
Private Shared AssemblyWebp As Assembly Private Shared AssemblyImazenWebp As Assembly
Private Shared ReadOnly AssemblyNAudioLock As New Object Private Shared ReadOnly AssemblyNAudioLock As New Object
Private Shared ReadOnly AssemblyJsonLock As New Object Private Shared ReadOnly AssemblyJsonLock As New Object
Private Shared ReadOnly AssemblyDialogLock As New Object Private Shared ReadOnly AssemblyDialogLock As New Object
Private Shared ReadOnly AssemblyWebpLock As New Object Private Shared ReadOnly AssemblyImazenWebpLock As New Object
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 If args.Name.StartsWithF("NAudio") Then
SyncLock AssemblyNAudioLock SyncLock AssemblyNAudioLock
@@ -208,12 +222,14 @@ Public Class Application
Return AssemblyDialog Return AssemblyDialog
End SyncLock End SyncLock
ElseIf args.Name.StartsWithF("Imazen.WebP") Then ElseIf args.Name.StartsWithF("Imazen.WebP") Then
SyncLock AssemblyWebpLock SyncLock AssemblyImazenWebpLock
If AssemblyWebp Is Nothing Then If AssemblyImazenWebp Is Nothing Then
Log("[Start] 加载 DLL:Imazen.WebP") Log("[Start] 加载 DLL:Imazen.WebP")
AssemblyWebp = Assembly.Load(GetResources("WebP")) AssemblyImazenWebp = Assembly.Load(GetResources("Imazen_WebP"))
SetDllDirectory(PathPure.TrimEnd("\"))
WriteFile(PathPure & "libwebp.dll", GetResources("libwebp64"))
End If End If
Return AssemblyWebp Return AssemblyImazenWebp
End SyncLock End SyncLock
Else Else
Return Nothing Return Nothing
@@ -7,7 +7,7 @@
<Border.RenderTransform> <Border.RenderTransform>
<ScaleTransform /> <ScaleTransform />
</Border.RenderTransform> </Border.RenderTransform>
<TextBlock TextOptions.TextFormattingMode="Display" SnapsToDevicePixels="True" TextTrimming="None" Text="Button" HorizontalAlignment="Center" x:Name="LabText" VerticalAlignment="Center" RenderTransformOrigin="0.5,0.5" Foreground="{Binding Parent.BorderBrush, RelativeSource={RelativeSource Self}}" FontSize="13" IsHitTestVisible="False"> <TextBlock TextOptions.TextFormattingMode="Display" SnapsToDevicePixels="True" TextTrimming="None" HorizontalAlignment="Center" x:Name="LabText" VerticalAlignment="Center" RenderTransformOrigin="0.5,0.5" Foreground="{Binding Parent.BorderBrush, RelativeSource={RelativeSource Self}}" FontSize="13" IsHitTestVisible="False">
<TextBlock.RenderTransform> <TextBlock.RenderTransform>
<ScaleTransform /> <ScaleTransform />
</TextBlock.RenderTransform> </TextBlock.RenderTransform>
@@ -1,22 +1,30 @@
Public Class MyButton Imports System.Windows.Markup
<ContentProperty("Inlines")>
Public Class MyButton
'声明 '声明
Public Event Click(sender As Object, e As MouseButtonEventArgs) '自定义事件 Public Event Click(sender As Object, e As MouseButtonEventArgs) '自定义事件
'自定义属性 '自定义属性
Public Uuid As Integer = GetUuid() Public Uuid As Integer = GetUuid()
Public ReadOnly Property Inlines As InlineCollection
Get
Return LabText.Inlines
End Get
End Property
Public Property Text As String Public Property Text As String
Get Get
Return LabText.Text Return GetValue(TextProperty)
End Get End Get
Set(value As String) Set(value As String)
LabText.Text = value SetValue(TextProperty, value)
End Set End Set
End Property '显示文本 End Property '显示文本
Public Shared ReadOnly TextProperty As DependencyProperty = DependencyProperty.Register("Text", GetType(String), GetType(MyButton), New PropertyMetadata(New PropertyChangedCallback( Public Shared ReadOnly TextProperty As DependencyProperty = DependencyProperty.Register("Text", GetType(String), GetType(MyButton), New PropertyMetadata(New PropertyChangedCallback(
Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs) Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs)
If Not IsNothing(sender) Then CType(sender, MyButton).LabText.Text = e.NewValue If sender IsNot Nothing Then CType(sender, MyButton).LabText.Text = e.NewValue
End Sub))) End Sub)))
Public Property TextPadding As Thickness Public Property TextPadding As Thickness
Get Get
Return LabText.Padding Return LabText.Padding
+73 -52
View File
@@ -3,7 +3,7 @@
'控件 '控件
Inherits Grid Inherits Grid
Private ReadOnly MainGrid As Grid Private ReadOnly MainGrid As Grid
Private ReadOnly MainChrome As SystemDropShadowChrome Public ReadOnly Property MainChrome As SystemDropShadowChrome
Private ReadOnly MainBorder As Border Private ReadOnly MainBorder As Border
Public Property BorderChild As UIElement Public Property BorderChild As UIElement
Get Get
@@ -36,6 +36,20 @@
'属性 '属性
Public Uuid As Integer = GetUuid() Public Uuid As Integer = GetUuid()
Public ReadOnly Property Inlines As InlineCollection
Get
Return MainTextBlock.Inlines
End Get
End Property
Public Property CornerRadius As CornerRadius
Get
Return MainChrome.CornerRadius
End Get
Set(value As CornerRadius)
MainChrome.CornerRadius = value
MainBorder.CornerRadius = value
End Set
End Property
Public Property Title As String Public Property Title As String
Get Get
Return GetValue(TitleProperty) Return GetValue(TitleProperty)
@@ -62,7 +76,7 @@
If IsLoad Then Exit Sub If IsLoad Then Exit Sub
IsLoad = True IsLoad = True
'初次加载限定 '初次加载限定
If Title <> "" AndAlso MainTextBlock Is Nothing Then If MainTextBlock Is Nothing Then
MainTextBlock = New TextBlock With {.HorizontalAlignment = HorizontalAlignment.Left, .VerticalAlignment = VerticalAlignment.Top, .Margin = New Thickness(15, 12, 0, 0), .FontWeight = FontWeights.Bold, .FontSize = 13, .IsHitTestVisible = False} MainTextBlock = New TextBlock With {.HorizontalAlignment = HorizontalAlignment.Left, .VerticalAlignment = VerticalAlignment.Top, .Margin = New Thickness(15, 12, 0, 0), .FontWeight = FontWeights.Bold, .FontSize = 13, .IsHitTestVisible = False}
MainTextBlock.SetResourceReference(TextBlock.ForegroundProperty, "ColorBrush1") MainTextBlock.SetResourceReference(TextBlock.ForegroundProperty, "ColorBrush1")
MainTextBlock.SetBinding(TextBlock.TextProperty, New Binding("Title") With {.Source = Me, .Mode = BindingMode.OneWay}) MainTextBlock.SetBinding(TextBlock.TextProperty, New Binding("Title") With {.Source = Me, .Mode = BindingMode.OneWay})
@@ -98,13 +112,13 @@
'排序 '排序
Select Case Type Select Case Type
Case 3 Case 3
Stack.Tag = Sort(CType(Stack.Tag, List(Of DlOptiFineListEntry)), Function(a, b) VersionSortBoolean(a.NameDisplay, b.NameDisplay)) Stack.Tag = CType(Stack.Tag, List(Of DlOptiFineListEntry)).Sort(Function(a, b) VersionSortBoolean(a.NameDisplay, b.NameDisplay))
Case 4, 10 Case 4, 10
Stack.Tag = Sort(CType(Stack.Tag, List(Of DlLiteLoaderListEntry)), Function(a, b) VersionSortBoolean(a.Inherit, b.Inherit)) Stack.Tag = CType(Stack.Tag, List(Of DlLiteLoaderListEntry)).Sort(Function(a, b) VersionSortBoolean(a.Inherit, b.Inherit))
Case 6 Case 6
Stack.Tag = Sort(CType(Stack.Tag, List(Of DlForgeVersionEntry)), Function(a, b) a.Version > b.Version) Stack.Tag = CType(Stack.Tag, List(Of DlForgeVersionEntry)).Sort(Function(a, b) a.Version > b.Version)
Case 8, 9 Case 8, 9
Stack.Tag = Sort(CType(Stack.Tag, List(Of CompFile)), Function(a, b) a.ReleaseDate > b.ReleaseDate) Stack.Tag = CType(Stack.Tag, List(Of CompFile)).Sort(Function(a, b) a.ReleaseDate > b.ReleaseDate)
End Select End Select
'控件转换 '控件转换
Select Case Type Select Case Type
@@ -180,10 +194,10 @@
If Not IsNothing(MainTextBlock) Then AniList.Add(AaColor(MainTextBlock, TextBlock.ForegroundProperty, "ColorBrush2", 150)) If Not IsNothing(MainTextBlock) Then AniList.Add(AaColor(MainTextBlock, TextBlock.ForegroundProperty, "ColorBrush2", 150))
If Not IsNothing(MainSwap) Then AniList.Add(AaColor(MainSwap, Shapes.Path.FillProperty, "ColorBrush2", 150)) If Not IsNothing(MainSwap) Then AniList.Add(AaColor(MainSwap, Shapes.Path.FillProperty, "ColorBrush2", 150))
AniList.AddRange({ AniList.AddRange({
AaColor(MainChrome, SystemDropShadowChrome.ColorProperty, "ColorObject2", 180), AaColor(MainChrome, SystemDropShadowChrome.ColorProperty, "ColorObject2", 180),
AaColor(MainBorder, Border.BackgroundProperty, New MyColor(230, 255, 255, 255) - MainBorder.Background, 180), AaColor(MainBorder, Border.BackgroundProperty, New MyColor(230, 255, 255, 255) - MainBorder.Background, 180),
AaOpacity(MainChrome, 0.3 - MainChrome.Opacity, 180) AaOpacity(MainChrome, 0.3 - MainChrome.Opacity, 180)
}) })
AniStart(AniList, "MyCard Mouse " & Uuid) AniStart(AniList, "MyCard Mouse " & Uuid)
End Sub End Sub
Private Sub MyCard_MouseLeave(sender As Object, e As MouseEventArgs) Handles Me.MouseLeave Private Sub MyCard_MouseLeave(sender As Object, e As MouseEventArgs) Handles Me.MouseLeave
@@ -192,10 +206,10 @@
If Not IsNothing(MainTextBlock) Then AniList.Add(AaColor(MainTextBlock, TextBlock.ForegroundProperty, "ColorBrush1", 250)) If Not IsNothing(MainTextBlock) Then AniList.Add(AaColor(MainTextBlock, TextBlock.ForegroundProperty, "ColorBrush1", 250))
If Not IsNothing(MainSwap) Then AniList.Add(AaColor(MainSwap, Shapes.Path.FillProperty, "ColorBrush1", 250)) If Not IsNothing(MainSwap) Then AniList.Add(AaColor(MainSwap, Shapes.Path.FillProperty, "ColorBrush1", 250))
AniList.AddRange({ AniList.AddRange({
AaColor(MainChrome, SystemDropShadowChrome.ColorProperty, "ColorObject1", 300), AaColor(MainChrome, SystemDropShadowChrome.ColorProperty, "ColorObject1", 300),
AaColor(MainBorder, Border.BackgroundProperty, New MyColor(205, 255, 255, 255) - MainBorder.Background, 300), AaColor(MainBorder, Border.BackgroundProperty, New MyColor(205, 255, 255, 255) - MainBorder.Background, 300),
AaOpacity(MainChrome, 0.1 - MainChrome.Opacity, 300) AaOpacity(MainChrome, 0.1 - MainChrome.Opacity, 300)
}) })
AniStart(AniList, "MyCard Mouse " & Uuid) AniStart(AniList, "MyCard Mouse " & Uuid)
End Sub End Sub
@@ -222,20 +236,21 @@
'高度增加较大,使用弹起动画 '高度增加较大,使用弹起动画
Dim Delta As Double = MathClamp(Math.Abs(DeltaHeight) * 0.05, 3, 10) * Math.Sign(DeltaHeight) Dim Delta As Double = MathClamp(Math.Abs(DeltaHeight) * 0.05, 3, 10) * Math.Sign(DeltaHeight)
AnimList.AddRange({ AnimList.AddRange({
AaHeight(Me, DeltaHeight + Delta, 300, If(IsLoadAnimation, 30, 0), If(DeltaHeight > FrmMain.Height, New AniEaseInFluent(AniEasePower.ExtraStrong), New AniEaseOutFluent(AniEasePower.ExtraStrong))), AaHeight(Me, DeltaHeight + Delta, 300, If(IsLoadAnimation, 30, 0), If(DeltaHeight > FrmMain.Height, New AniEaseInFluent(AniEasePower.ExtraStrong), New AniEaseOutFluent(AniEasePower.ExtraStrong))),
AaHeight(Me, -Delta, 150, 260, Ease:=New AniEaseOutFluent(AniEasePower.Strong)) AaHeight(Me, -Delta, 150, 260, Ease:=New AniEaseOutFluent(AniEasePower.Strong))
}) })
Else Else
'普通的改变就行啦 '普通的改变就行啦
AnimList.AddRange({ AnimList.AddRange({
AaHeight(Me, DeltaHeight, MathClamp(Math.Abs(DeltaHeight) * 4, 150, 250),, New AniEaseOutFluent) AaHeight(Me, DeltaHeight, MathClamp(Math.Abs(DeltaHeight) * 4, 150, 250),, New AniEaseOutFluent)
}) })
End If End If
AnimList.Add(AaCode(Sub() AnimList.Add(AaCode(
IsHeightAnimating = False Sub()
Height = ActualUsedHeight IsHeightAnimating = False
If IsSwaped Then SwapControl.Visibility = Visibility.Collapsed Height = ActualUsedHeight
End Sub,, True)) If IsSwaped Then SwapControl.Visibility = Visibility.Collapsed
End Sub,, True))
AniStart(AnimList, "MyCard Height " & Uuid) AniStart(AnimList, "MyCard Height " & Uuid)
IsHeightAnimating = True IsHeightAnimating = True
@@ -253,7 +268,8 @@
#End Region #End Region
'折叠 #Region "折叠"
'若设置了 CanSwap,或 SwapControl 不为空,则判定为会进行折叠 '若设置了 CanSwap,或 SwapControl 不为空,则判定为会进行折叠
'这是因为不能直接在 XAML 中设置 SwapControl '这是因为不能直接在 XAML 中设置 SwapControl
Public SwapControl As Object Public SwapControl As Object
@@ -293,49 +309,54 @@
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 (IsNothing(SwapControl) OrElse Pos > SwapedHeight OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Exit Sub '检测点击位置;或已经不在可视树上的误判 If Not IsSwaped AndAlso
(SwapControl Is Nothing OrElse Pos > If(IsSwaped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Exit Sub '检测点击位置;或已经不在可视树上的误判
IsMouseDown = True IsMouseDown = True
End Sub End Sub
Private Sub MyCard_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp Private Sub MyCard_MouseLeftButtonUp(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonUp
If IsMouseDown Then If Not IsMouseDown Then Return
IsMouseDown = False
Dim Pos As Double = Mouse.GetPosition(Me).Y
If Not IsSwaped AndAlso
(SwapControl Is Nothing OrElse Pos > If(IsSwaped, SwapedHeight, SwapedHeight - 6) OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Exit Sub '检测点击位置;或已经不在可视树上的误判
Dim ee = New RouteEventArgs(True)
RaiseEvent PreviewSwap(Me, ee)
If ee.Handled Then
IsMouseDown = False IsMouseDown = False
Dim Pos As Double = Mouse.GetPosition(Me).Y Return
If Not IsSwaped AndAlso (IsNothing(SwapControl) OrElse Pos > SwapedHeight OrElse (Pos = 0 AndAlso Not IsMouseDirectlyOver)) Then Exit Sub '检测点击位置;或已经不在可视树上的误判
Dim ee = New RouteEventArgs(True)
RaiseEvent PreviewSwap(Me, ee)
If ee.Handled Then
IsMouseDown = False
Exit Sub
End If
IsSwaped = Not IsSwaped
Log("[Control] " & If(IsSwaped, "折叠卡片", "展开卡片") & If(Title Is Nothing, "", ":" & Title))
RaiseEvent Swap(Me, ee)
End If End If
IsSwaped = Not IsSwaped
Log("[Control] " & If(IsSwaped, "折叠卡片", "展开卡片") & If(Title Is Nothing, "", ":" & Title))
RaiseEvent Swap(Me, ee)
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 IsMouseDown = False
End Sub End Sub
#End Region
End Class End Class
Partial Public Module ModAnimation Partial Public Module ModAnimation
Public Sub AniDispose(Control As MyCard, RemoveFromChildren As Boolean, Optional CallBack As ParameterizedThreadStart = Nothing) Public Sub AniDispose(Control As MyCard, RemoveFromChildren As Boolean, Optional CallBack As ParameterizedThreadStart = Nothing)
If Control.IsHitTestVisible Then If Control.IsHitTestVisible Then
Control.IsHitTestVisible = False Control.IsHitTestVisible = False
AniStart({ AniStart({
AaScaleTransform(Control, -0.08, 200,, New AniEaseInFluent), AaScaleTransform(Control, -0.08, 200,, New AniEaseInFluent),
AaOpacity(Control, -1, 200,, New AniEaseOutFluent), AaOpacity(Control, -1, 200,, New AniEaseOutFluent),
AaHeight(Control, -Control.ActualHeight, 150, 100, New AniEaseOutFluent), AaHeight(Control, -Control.ActualHeight, 150, 100, New AniEaseOutFluent),
AaCode(Sub() AaCode(
If RemoveFromChildren Then Sub()
If Control.Parent Is Nothing Then Exit Sub If RemoveFromChildren Then
CType(Control.Parent, Object).Children.Remove(Control) If Control.Parent Is Nothing Then Exit Sub
Else CType(Control.Parent, Object).Children.Remove(Control)
Control.Visibility = Visibility.Collapsed Else
End If Control.Visibility = Visibility.Collapsed
If CallBack IsNot Nothing Then CallBack(Control) End If
End Sub,, True) If CallBack IsNot Nothing Then CallBack(Control)
End Sub,, True)
}, "MyCard Dispose " & Control.Uuid) }, "MyCard Dispose " & Control.Uuid)
Else Else
If RemoveFromChildren Then If RemoveFromChildren Then
@@ -4,7 +4,7 @@
xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" mc:Ignorable="d" x:Class="MyCheckBox" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" mc:Ignorable="d" x:Class="MyCheckBox"
FocusVisualStyle="{x:Null}" FocusVisualStyle="{x:Null}"
MinWidth="20" x:Name="PanBack" UseLayoutRounding="False" SnapsToDevicePixels="False" MinHeight="20" Background="{StaticResource ColorBrushSemiTransparent}" Focusable="True" d:DesignWidth="126.4" d:DesignHeight="44.8"> MinWidth="20" x:Name="PanBack" UseLayoutRounding="False" SnapsToDevicePixels="False" MinHeight="20" Background="{StaticResource ColorBrushSemiTransparent}" Focusable="True" d:DesignWidth="126.4" d:DesignHeight="44.8">
<TextBlock IsHitTestVisible="False" FontSize="13" x:Name="LabText" Padding="0" Margin="26,0,0,0" Text="Checkbox" Foreground="{DynamicResource ColorBrush1}" HorizontalAlignment="Left" VerticalAlignment="Center" /> <TextBlock IsHitTestVisible="False" FontSize="13" x:FieldModifier="Public" x:Name="LabText" Padding="0" Margin="26,0,0,0" Foreground="{DynamicResource ColorBrush1}" HorizontalAlignment="Left" VerticalAlignment="Center" />
<Border IsHitTestVisible="False" x:Name="ShapeBorder" BorderThickness="1.1" HorizontalAlignment="Left" VerticalAlignment="Center" Width="18" Height="18" BorderBrush="{DynamicResource ColorBrush1}" CornerRadius="3" Margin="1,0,0,0" Background="{StaticResource ColorBrushHalfWhite}" /> <Border IsHitTestVisible="False" x:Name="ShapeBorder" BorderThickness="1.1" HorizontalAlignment="Left" VerticalAlignment="Center" Width="18" Height="18" BorderBrush="{DynamicResource ColorBrush1}" CornerRadius="3" Margin="1,0,0,0" Background="{StaticResource ColorBrushHalfWhite}" />
<Path IsHitTestVisible="False" x:Name="ShapeCheck" HorizontalAlignment="Left" VerticalAlignment="Center" Fill="{Binding BorderBrush, ElementName=ShapeBorder}" Width="12" Height="12" Margin="4,0,0,0" Data="M0,6L1.5,4.5 4.5,7.5 10.5,1.5 12,3 4.5,10.5 0,6z"> <Path IsHitTestVisible="False" x:Name="ShapeCheck" HorizontalAlignment="Left" VerticalAlignment="Center" Fill="{Binding BorderBrush, ElementName=ShapeBorder}" Width="12" Height="12" Margin="4,0,0,0" Data="M0,6L1.5,4.5 4.5,7.5 10.5,1.5 12,3 4.5,10.5 0,6z">
<Path.RenderTransform> <Path.RenderTransform>
@@ -1,4 +1,7 @@
Public Class MyCheckBox Imports System.Windows.Markup
<ContentProperty("Inlines")>
Public Class MyCheckBox
'基础 '基础
@@ -14,29 +17,32 @@
End Sub '使外部程序引发本控件的 Change 事件 End Sub '使外部程序引发本控件的 Change 事件
'自定义属性 '自定义属性
Private _Checked As Boolean = False '是否选中
Public Property Checked As Boolean Public Property Checked As Boolean
Get Get
Return _Checked Return GetValue(CheckedProperty)
End Get End Get
Set(value As Boolean) Set(value As Boolean)
SetChecked(value, False, True) SetChecked(value, False)
End Set End Set
End Property End Property
Public Shared ReadOnly CheckedProperty As DependencyProperty =
DependencyProperty.Register("Checked", GetType(Boolean), GetType(MyCheckBox), New PropertyMetadata(False,
Sub(d As MyCheckBox, e As DependencyPropertyChangedEventArgs)
'在使用 XAML 设置 Checked 属性时,不会触发 Checked_Set 方法,所以需要在这里手动触发 UI 改变
If Not d.IsLoaded Then d.SyncUI()
End Sub))
Private Const AnimationTimeOfCheck As Integer = 150 '勾选状态变更动画长度 Private Const AnimationTimeOfCheck As Integer = 150 '勾选状态变更动画长度
''' <summary> ''' <summary>
''' 手动设置 Checked 属性。 ''' 手动设置 Checked 属性。
''' </summary> ''' </summary>
''' <param name="value">新的 Checked 属性。</param> ''' <param name="value">新的 Checked 属性。</param>
''' <param name="user">是否由用户引发。</param> ''' <param name="user">是否由用户引发。</param>
''' <param name="anime">是否执行动画。</param> Public Sub SetChecked(value As Boolean, user As Boolean)
Public Sub SetChecked(value As Boolean, user As Boolean, anime As Boolean)
Try Try
If value = _Checked Then Exit Sub If value = Checked Then Exit Sub
'Preview 事件 'Preview 事件
If value AndAlso user Then If value AndAlso user Then
Dim e = New RouteEventArgs(user) Dim e = New RouteEventArgs(user)
RaiseEvent PreviewChange(Me, e) RaiseEvent PreviewChange(Me, e)
@@ -48,60 +54,67 @@
End If End If
End If End If
_Checked = value SetValue(CheckedProperty, value)
If IsLoaded Then RaiseEvent Change(Me, user) If IsLoaded Then RaiseEvent Change(Me, user)
'更改动画 '更改动画
SyncUI()
If IsLoaded AndAlso AniControlEnabled = 0 AndAlso anime Then '防止默认属性变更触发动画
AllowMouseDown = False
If Checked Then
'由无变有
AniStart({
AaScale(ShapeBorder, 12 - ShapeBorder.Width, AnimationTimeOfCheck, , New AniEaseOutFluent, , True),
AaScaleTransform(ShapeCheck, 1 - CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.7, New AniEaseOutBack(AniEasePower.Weak)),
AaScale(ShapeBorder, 6, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.7, New AniEaseOutBack, , True)
}, "MyCheckBox Scale " & Uuid)
AniStart({
AaColor(ShapeBorder, Border.BorderBrushProperty, If(IsEnabled, If(IsMouseOver, "ColorBrush3", "ColorBrush2"), "ColorBrushGray4"), AnimationTimeOfCheck)
}, "MyCheckBox BorderColor " & Uuid)
AniStart({
AaCode(Sub() AllowMouseDown = True, AnimationTimeOfCheck * 2)
}, "MyCheckBox AllowMouseDown " & Uuid)
Else
'由有变无
AniStart({
AaScale(ShapeBorder, 12 - ShapeBorder.Width, AnimationTimeOfCheck, , New AniEaseOutFluent, , True),
AaScaleTransform(ShapeCheck, -CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX, AnimationTimeOfCheck * 0.9, , New AniEaseInFluent(AniEasePower.Weak)),
AaScale(ShapeBorder, 6, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.7, New AniEaseOutBack, , True)
}, "MyCheckBox Scale " & Uuid)
AniStart({
AaColor(ShapeBorder, Border.BorderBrushProperty, If(IsEnabled, If(IsMouseOver, "ColorBrush3", "ColorBrush1"), "ColorBrushGray4"), AnimationTimeOfCheck)
}, "MyCheckBox BorderColor " & Uuid)
AniStart({
AaCode(Sub() AllowMouseDown = True, AnimationTimeOfCheck * 2)
}, "MyCheckBox AllowMouseDown " & Uuid)
End If
Else
'不使用动画
AniStop("MyCheckBox Scale " & Uuid)
AniStop("MyCheckBox BorderColor " & Uuid)
AniStop("MyCheckBox AllowMouseDown " & Uuid)
If Checked Then
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX = 1
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleY = 1
ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(IsEnabled, "ColorBrush2", "ColorBrushGray4"))
Else
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX = 0
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleY = 0
ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4"))
End If
End If
Catch ex As Exception Catch ex As Exception
Log(ex, "设置 Checked 失败") Log(ex, "设置 Checked 失败")
End Try End Try
End Sub End Sub
Private Sub SyncUI()
If AniControlEnabled = 0 AndAlso IsLoaded Then '防止默认属性变更触发动画
AllowMouseDown = False
If Checked Then
'由无变有
AniStart({
AaScale(ShapeBorder, 12 - ShapeBorder.Width, AnimationTimeOfCheck, , New AniEaseOutFluent, , True),
AaScaleTransform(ShapeCheck, 1 - CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.7, New AniEaseOutBack(AniEasePower.Weak)),
AaScale(ShapeBorder, 6, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.7, New AniEaseOutBack, , True)
}, "MyCheckBox Scale " & Uuid)
AniStart({
AaColor(ShapeBorder, Border.BorderBrushProperty, If(IsEnabled, If(IsMouseOver, "ColorBrush3", "ColorBrush2"), "ColorBrushGray4"), AnimationTimeOfCheck)
}, "MyCheckBox BorderColor " & Uuid)
AniStart({
AaCode(Sub() AllowMouseDown = True, AnimationTimeOfCheck * 2)
}, "MyCheckBox AllowMouseDown " & Uuid)
Else
'由有变无
AniStart({
AaScale(ShapeBorder, 12 - ShapeBorder.Width, AnimationTimeOfCheck, , New AniEaseOutFluent, , True),
AaScaleTransform(ShapeCheck, -CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX, AnimationTimeOfCheck * 0.9, , New AniEaseInFluent(AniEasePower.Weak)),
AaScale(ShapeBorder, 6, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.7, New AniEaseOutBack, , True)
}, "MyCheckBox Scale " & Uuid)
AniStart({
AaColor(ShapeBorder, Border.BorderBrushProperty, If(IsEnabled, If(IsMouseOver, "ColorBrush3", "ColorBrush1"), "ColorBrushGray4"), AnimationTimeOfCheck)
}, "MyCheckBox BorderColor " & Uuid)
AniStart({
AaCode(Sub() AllowMouseDown = True, AnimationTimeOfCheck * 2)
}, "MyCheckBox AllowMouseDown " & Uuid)
End If
Else
'不使用动画
AniStop("MyCheckBox Scale " & Uuid)
AniStop("MyCheckBox BorderColor " & Uuid)
AniStop("MyCheckBox AllowMouseDown " & Uuid)
If Checked Then
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX = 1
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleY = 1
ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(IsEnabled, "ColorBrush2", "ColorBrushGray4"))
Else
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleX = 0
CType(ShapeCheck.RenderTransform, ScaleTransform).ScaleY = 0
ShapeBorder.SetResourceReference(Border.BorderBrushProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4"))
End If
End If
End Sub
Public ReadOnly Property Inlines As InlineCollection
Get
Return LabText.Inlines
End Get
End Property
Public Property Text As String Public Property Text As String
Get Get
Return GetValue(TextProperty) Return GetValue(TextProperty)
@@ -110,10 +123,10 @@
SetValue(TextProperty, value) SetValue(TextProperty, value)
End Set End Set
End Property '内容 End Property '内容
Public Shared ReadOnly TextProperty As DependencyProperty = DependencyProperty.Register("Text", GetType(String), GetType(MyCheckbox), New PropertyMetadata(New PropertyChangedCallback( Public Shared ReadOnly TextProperty As DependencyProperty = DependencyProperty.Register("Text", GetType(String), GetType(MyCheckBox), New PropertyMetadata(New PropertyChangedCallback(
Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs) Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs)
If Not IsNothing(sender) Then CType(sender, MyCheckbox).LabText.Text = e.NewValue If Not IsNothing(sender) Then CType(sender, MyCheckBox).LabText.Text = e.NewValue
End Sub))) End Sub)))
'点击事件 '点击事件
@@ -123,7 +136,7 @@
If Not MouseDowned Then Exit Sub If Not MouseDowned Then Exit Sub
Log("[Control] 按下复选框(" & (Not Checked).ToString & "):" & Text) Log("[Control] 按下复选框(" & (Not Checked).ToString & "):" & Text)
MouseDowned = False MouseDowned = False
SetChecked(Not Checked, True, True) SetChecked(Not Checked, True)
AniStart(AaColor(ShapeBorder, Border.BackgroundProperty, "ColorBrushHalfWhite", 100), "MyCheckBox Background " & Uuid) AniStart(AaColor(ShapeBorder, Border.BackgroundProperty, "ColorBrushHalfWhite", 100), "MyCheckBox Background " & Uuid)
End Sub End Sub
Private Sub Checkbox_MouseDown() Handles Me.MouseLeftButtonDown Private Sub Checkbox_MouseDown() Handles Me.MouseLeftButtonDown
@@ -113,9 +113,9 @@
Private Sub Button_LeftMouseDown(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseLeftButtonDown Private Sub Button_LeftMouseDown(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseLeftButtonDown
If Not IsLeftMouseHeld AndAlso Not IsRightMouseHeld Then If Not IsLeftMouseHeld AndAlso Not IsRightMouseHeld Then
AniStart({ AniStart({
AaScaleTransform(PanScale, 0.85 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 800,, New AniEaseOutFluent(AniEasePower.Strong)), AaScaleTransform(PanScale, 0.85 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 800,, New AniEaseOutFluent(AniEasePower.Strong)),
AaScaleTransform(PanScale, -0.05, 60,, New AniEaseOutFluent) AaScaleTransform(PanScale, -0.05, 60,, New AniEaseOutFluent)
}, "MyExtraButton Scale " & Uuid) }, "MyExtraButton Scale " & Uuid)
End If End If
IsLeftMouseHeld = True IsLeftMouseHeld = True
Focus() Focus()
@@ -124,9 +124,9 @@
If Not CanRightClick Then Exit Sub If Not CanRightClick Then Exit Sub
If Not IsLeftMouseHeld AndAlso Not IsRightMouseHeld Then If Not IsLeftMouseHeld AndAlso Not IsRightMouseHeld Then
AniStart({ AniStart({
AaScaleTransform(PanScale, 0.85 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 800,, New AniEaseOutFluent(AniEasePower.Strong)), AaScaleTransform(PanScale, 0.85 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 800,, New AniEaseOutFluent(AniEasePower.Strong)),
AaScaleTransform(PanScale, -0.05, 60,, New AniEaseOutFluent) AaScaleTransform(PanScale, -0.05, 60,, New AniEaseOutFluent)
}, "MyExtraButton Scale " & Uuid) }, "MyExtraButton Scale " & Uuid)
End If End If
IsRightMouseHeld = True IsRightMouseHeld = True
Focus() Focus()
@@ -134,8 +134,8 @@
Private Sub Button_LeftMouseUp() Handles PanClick.MouseLeftButtonUp Private Sub Button_LeftMouseUp() Handles PanClick.MouseLeftButtonUp
If Not IsRightMouseHeld Then If Not IsRightMouseHeld Then
AniStart({ AniStart({
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
IsLeftMouseHeld = False IsLeftMouseHeld = False
RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave
@@ -144,8 +144,8 @@
If Not CanRightClick Then Exit Sub If Not CanRightClick Then Exit Sub
If Not IsLeftMouseHeld Then If Not IsLeftMouseHeld Then
AniStart({ AniStart({
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
IsRightMouseHeld = False IsRightMouseHeld = False
RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave
@@ -154,8 +154,8 @@
IsLeftMouseHeld = False IsLeftMouseHeld = False
IsRightMouseHeld = False IsRightMouseHeld = False
AniStart({ AniStart({
AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 500,, New AniEaseOutFluent) AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 500,, New AniEaseOutFluent)
}, "MyExtraButton Scale " & Uuid) }, "MyExtraButton Scale " & Uuid)
RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave
End Sub End Sub
@@ -163,11 +163,14 @@
'务必放在 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
Public Sub RefreshColor() Handles PanClick.MouseEnter, PanClick.MouseLeave, Me.Loaded Public Sub RefreshColor() Handles PanClick.MouseEnter, PanClick.MouseLeave, Me.Loaded, Me.IsEnabledChanged
Try Try
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画 If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
If IsMouseOver Then If Not IsEnabled Then
'禁用
AniStart(AaColor(PanColor, BackgroundProperty, "ColorBrushGray4", AnimationColorIn), "MyExtraButton Color " & Uuid)
ElseIf IsMouseOver Then
'指向 '指向
AniStart(AaColor(PanColor, BackgroundProperty, "ColorBrush4", AnimationColorIn), "MyExtraButton Color " & Uuid) AniStart(AaColor(PanColor, BackgroundProperty, "ColorBrush4", AnimationColorIn), "MyExtraButton Color " & Uuid)
Else Else
@@ -178,7 +181,9 @@
Else Else
AniStop("MyExtraButton Color " & Uuid) AniStop("MyExtraButton Color " & Uuid)
If IsMouseOver Then If Not IsEnabled Then
PanColor.SetResourceReference(BackgroundProperty, "ColorBrushGray4")
ElseIf IsMouseOver Then
PanColor.SetResourceReference(BackgroundProperty, "ColorBrush4") PanColor.SetResourceReference(BackgroundProperty, "ColorBrush4")
Else Else
PanColor.SetResourceReference(BackgroundProperty, "ColorBrush3") PanColor.SetResourceReference(BackgroundProperty, "ColorBrush3")
@@ -0,0 +1,33 @@
<Grid
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"
x:Name="PanBack" mc:Ignorable="d" x:Class="MyExtraTextButton"
RenderTransformOrigin="0.5,0.5" ToolTipService.Placement="Left" Height="52" Margin="20">
<Grid.RenderTransform>
<ScaleTransform ScaleX="0" ScaleY="0" />
</Grid.RenderTransform>
<Border x:Name="PanClick" BorderThickness="0.001" Background="{StaticResource ColorBrushSemiTransparent}"
CornerRadius="{Binding ActualHeight, ConverterParameter=0.4, Converter={StaticResource MultiplicationConverter}, ElementName=PanBack, Mode=OneWay}"/>
<Grid x:Name="PanScale" IsHitTestVisible="False" RenderTransformOrigin="0.5,0.5" Margin="0,10,0,0">
<Grid.RenderTransform>
<ScaleTransform />
</Grid.RenderTransform>
<Border x:Name="PanColor" BorderThickness="0.001" Background="{DynamicResource ColorBrush3}"
CornerRadius="{Binding ActualHeight, ConverterParameter=0.4, Converter={StaticResource MultiplicationConverter}, ElementName=PanBack, Mode=OneWay}">
<Border.Effect>
<DropShadowEffect ShadowDepth="0" BlurRadius="10" Opacity="0.2" />
</Border.Effect>
</Border>
<StackPanel Orientation="Horizontal" Margin="20,0" SnapsToDevicePixels="False" UseLayoutRounding="False">
<Path x:Name="Path" Stretch="Uniform" Margin="2,12,0,12" Fill="{DynamicResource ColorBrush8}" RenderTransformOrigin="0.5,0.5">
<Path.RenderTransform>
<ScaleTransform />
</Path.RenderTransform>
</Path>
<TextBlock x:Name="LabText" VerticalAlignment="Center" Foreground="{DynamicResource ColorBrush8}" FontSize="16"
Margin="12,0,0,0.8" />
</StackPanel>
</Grid>
</Grid>
@@ -0,0 +1,163 @@
Imports System.Windows.Markup
<ContentProperty("Inlines")>
Public Class MyExtraTextButton
'声明
Public Event Click(sender As Object, e As MouseButtonEventArgs) '自定义事件
'自定义属性
Public Uuid As Integer = GetUuid()
Private _Logo As String = ""
Public Property Logo As String
Get
Return _Logo
End Get
Set(value As String)
If value = _Logo Then Exit Property
_Logo = value
Path.Data = (New GeometryConverter).ConvertFromString(value)
End Set
End Property
Private _LogoScale As Double = 1
Public Property LogoScale() As Double
Get
Return _LogoScale
End Get
Set(value As Double)
_LogoScale = value
If Path IsNot Nothing Then Path.RenderTransform = New ScaleTransform With {.ScaleX = LogoScale, .ScaleY = LogoScale}
End Set
End Property
'显示文本
Public ReadOnly Property Inlines As InlineCollection
Get
Return LabText.Inlines
End Get
End Property
Public Property Text As String
Get
Return GetValue(TextProperty)
End Get
Set(value As String)
SetValue(TextProperty, value)
End Set
End Property
Public Shared ReadOnly TextProperty As DependencyProperty = DependencyProperty.Register("Text", GetType(String), GetType(MyExtraTextButton), New PropertyMetadata(New PropertyChangedCallback(
Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs)
If sender IsNot Nothing Then CType(sender, MyExtraTextButton).LabText.Text = e.NewValue
End Sub)))
'动画
Private _Show As Boolean = False
Public Property Show As Boolean
Get
Return _Show
End Get
Set(value As Boolean)
If _Show = value Then Exit Property
_Show = value
RunInUi(
Sub()
If value Then
'有了
Opacity = 0
AniStart({
AaOpacity(Me, 1 - Opacity, 80, 50),
AaScaleTransform(Me, 0.15 - CType(RenderTransform, ScaleTransform).ScaleX, 400, 50, New AniEaseOutBack),
AaScaleTransform(Me, 0.85, 160, 50, New AniEaseOutFluent(AniEasePower.Middle))
}, "MyExtraTextButton MainScale " & Uuid)
Else
'没了
AniStart({
AaOpacity(Me, -Opacity, 50, 50),
AaScaleTransform(Me, -CType(RenderTransform, ScaleTransform).ScaleX, 100,, New AniEaseInFluent(AniEasePower.Weak))
}, "MyExtraTextButton MainScale " & Uuid)
End If
IsHitTestVisible = value '防止缩放动画中依然可以点进去
End Sub)
End Set
End Property
'触发点击事件
Private Sub Button_LeftMouseUp(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseLeftButtonUp
If IsLeftMouseHeld Then
Log("[Control] 按下附加图标按钮:" & Text)
RaiseEvent Click(sender, e)
e.Handled = True
Button_LeftMouseUp()
End If
End Sub
'鼠标点击判定(务必放在点击事件之后,以使得 Button_MouseUp 先于 Button_MouseLeave 执行)
Private IsLeftMouseHeld As Boolean = False
Private Sub Button_LeftMouseDown(sender As Object, e As MouseButtonEventArgs) Handles PanClick.MouseLeftButtonDown
If Not IsLeftMouseHeld Then
AniStart({
AaScaleTransform(PanScale, 0.85 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 800,, New AniEaseOutFluent(AniEasePower.Strong)),
AaScaleTransform(PanScale, -0.05, 60,, New AniEaseOutFluent)
}, "MyExtraTextButton Scale " & Uuid)
End If
IsLeftMouseHeld = True
Focus()
End Sub
Private Sub Button_LeftMouseUp() Handles PanClick.MouseLeftButtonUp
AniStart({
AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 300,, New AniEaseOutBack)
}, "MyExtraTextButton Scale " & Uuid)
IsLeftMouseHeld = False
RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave
End Sub
Private Sub Button_RightMouseUp() Handles PanClick.MouseRightButtonUp
If Not IsLeftMouseHeld Then
AniStart({
AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 300,, New AniEaseOutBack)
}, "MyExtraTextButton Scale " & Uuid)
End If
RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave
End Sub
Private Sub Button_MouseLeave() Handles PanClick.MouseLeave
IsLeftMouseHeld = False
AniStart({
AaScaleTransform(PanScale, 1 - CType(PanScale.RenderTransform, ScaleTransform).ScaleX, 500,, New AniEaseOutFluent)
}, "MyExtraTextButton Scale " & Uuid)
RefreshColor() '直接刷新颜色以判断是否已触发 MouseLeave
End Sub
'自定义事件
'务必放在 IsMouseDown 更新之后
Private Const AnimationColorIn As Integer = 120
Private Const AnimationColorOut As Integer = 150
Public Sub RefreshColor() Handles PanClick.MouseEnter, PanClick.MouseLeave, Me.Loaded, Me.IsEnabledChanged
Try
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
If Not IsEnabled Then
'禁用
AniStart(AaColor(PanColor, BackgroundProperty, "ColorBrushGray4", AnimationColorIn), "MyExtraTextButton Color " & Uuid)
ElseIf IsMouseOver Then
'指向
AniStart(AaColor(PanColor, BackgroundProperty, "ColorBrush4", AnimationColorIn), "MyExtraTextButton Color " & Uuid)
Else
'普通
AniStart(AaColor(PanColor, BackgroundProperty, "ColorBrush3", AnimationColorOut), "MyExtraTextButton Color " & Uuid)
End If
Else
AniStop("MyExtraTextButton Color " & Uuid)
If Not IsEnabled Then
PanColor.SetResourceReference(BackgroundProperty, "ColorBrushGray4")
ElseIf IsMouseOver Then
PanColor.SetResourceReference(BackgroundProperty, "ColorBrush4")
Else
PanColor.SetResourceReference(BackgroundProperty, "ColorBrush3")
End If
End If
Catch ex As Exception
Log(ex, "刷新附加图标按钮颜色出错")
End Try
End Sub
End Class
+1 -1
View File
@@ -17,7 +17,7 @@
<ColumnDefinition Width="Auto" /> <ColumnDefinition Width="Auto" />
</Grid.ColumnDefinitions> </Grid.ColumnDefinitions>
<Path IsHitTestVisible="False" Grid.Column="0" x:Name="Path" VerticalAlignment="Center" Fill="#BF0000" Width="14" Stretch="Uniform" Margin="10,0,2,0" Data="F1 M 58.5832,55.4172L 17.4169,55.4171C 15.5619,53.5621 15.5619,50.5546 17.4168,48.6996L 35.201,15.8402C 37.056,13.9852 40.0635,13.9852 41.9185,15.8402L 58.5832,48.6997C 60.4382,50.5546 60.4382,53.5622 58.5832,55.4172 Z M 34.0417,25.7292L 36.0208,41.9584L 39.9791,41.9583L 41.9583,25.7292L 34.0417,25.7292 Z M 38,44.3333C 36.2511,44.3333 34.8333,45.7511 34.8333,47.5C 34.8333,49.2489 36.2511,50.6667 38,50.6667C 39.7489,50.6667 41.1666,49.2489 41.1666,47.5C 41.1666,45.7511 39.7489,44.3333 38,44.3333 Z " /> <Path IsHitTestVisible="False" Grid.Column="0" x:Name="Path" VerticalAlignment="Center" Fill="#BF0000" Width="14" Stretch="Uniform" Margin="10,0,2,0" Data="F1 M 58.5832,55.4172L 17.4169,55.4171C 15.5619,53.5621 15.5619,50.5546 17.4168,48.6996L 35.201,15.8402C 37.056,13.9852 40.0635,13.9852 41.9185,15.8402L 58.5832,48.6997C 60.4382,50.5546 60.4382,53.5622 58.5832,55.4172 Z M 34.0417,25.7292L 36.0208,41.9584L 39.9791,41.9583L 41.9583,25.7292L 34.0417,25.7292 Z M 38,44.3333C 36.2511,44.3333 34.8333,45.7511 34.8333,47.5C 34.8333,49.2489 36.2511,50.6667 38,50.6667C 39.7489,50.6667 41.1666,49.2489 41.1666,47.5C 41.1666,45.7511 39.7489,44.3333 38,44.3333 Z " />
<TextBlock IsHitTestVisible="False" Grid.Column="1" x:Name="LabText" Margin="0,0.5,0,0" Padding="6,6,8,6" Text="提示文本" VerticalAlignment="Center" Foreground="#BF0000" TextWrapping="Wrap" /> <TextBlock IsHitTestVisible="False" Grid.Column="1" x:Name="LabText" Margin="0,0.5,0,0" Padding="6,6,8,6" VerticalAlignment="Center" Foreground="#BF0000" TextWrapping="Wrap" />
<local:MyIconButton x:Name="BtnClose" SnapsToDevicePixels="True" Visibility="Collapsed" Foreground="#BF0000" Theme="Custom" Margin="0,0,6,0" Grid.Column="2" Height="20" Width="20" VerticalAlignment="Center" Logo="F1 M 26.9166,22.1667L 37.9999,33.25L 49.0832,22.1668L 53.8332,26.9168L 42.7499,38L 53.8332,49.0834L 49.0833,53.8334L 37.9999,42.75L 26.9166,53.8334L 22.1666,49.0833L 33.25,38L 22.1667,26.9167L 26.9166,22.1667 Z" <local:MyIconButton x:Name="BtnClose" SnapsToDevicePixels="True" Visibility="Collapsed" Foreground="#BF0000" Theme="Custom" Margin="0,0,6,0" Grid.Column="2" Height="20" Width="20" VerticalAlignment="Center" Logo="F1 M 26.9166,22.1667L 37.9999,33.25L 49.0832,22.1668L 53.8332,26.9168L 42.7499,38L 53.8332,49.0834L 49.0833,53.8334L 37.9999,42.75L 26.9166,53.8334L 22.1666,49.0833L 33.25,38L 22.1667,26.9167L 26.9166,22.1667 Z"
ToolTip="不再显示" ToolTipService.Placement="Center" ToolTipService.VerticalOffset="29" ToolTipService.HorizontalOffset="2" /> ToolTip="不再显示" ToolTipService.Placement="Center" ToolTipService.VerticalOffset="29" ToolTipService.HorizontalOffset="2" />
</Grid> </Grid>
+17 -4
View File
@@ -1,4 +1,7 @@
Public Class MyHint Imports System.Windows.Markup
<ContentProperty("Inlines")>
Public Class MyHint
Public Uuid As Integer = GetUuid() Public Uuid As Integer = GetUuid()
@@ -30,14 +33,24 @@
End Set End Set
End Property End Property
Public ReadOnly Property Inlines As InlineCollection
Get
Return LabText.Inlines
End Get
End Property
Public Property Text As String Public Property Text As String
Get Get
Return LabText.Text Return GetValue(TextProperty)
End Get End Get
Set(value As String) Set(value As String)
LabText.Text = value SetValue(TextProperty, value)
End Set End Set
End Property End Property
Public Shared ReadOnly TextProperty As DependencyProperty =
DependencyProperty.Register("Text", GetType(String), GetType(MyHint), New PropertyMetadata("",
Sub(d As MyHint, e As DependencyPropertyChangedEventArgs)
d.LabText.Text = e.NewValue
End Sub))
Public Property CanClose As Boolean Public Property CanClose As Boolean
Get Get
@@ -48,7 +61,7 @@
End Set End Set
End Property End Property
Public 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 If CanClose AndAlso Setup.Get(RelativeSetup) Then
Visibility = Visibility.Collapsed Visibility = Visibility.Collapsed
@@ -1,4 +1,7 @@
Public Class MyIconTextButton Imports System.Windows.Markup
<ContentProperty("Inlines")>
Public Class MyIconTextButton
'基础 '基础
@@ -30,6 +33,11 @@
End Set End Set
End Property End Property
Public ReadOnly Property Inlines As InlineCollection
Get
Return LabText.Inlines
End Get
End Property
Public Property Text As String Public Property Text As String
Get Get
Return GetValue(TextProperty) Return GetValue(TextProperty)
@@ -39,25 +47,25 @@
End Set End Set
End Property '内容 End Property '内容
Public Shared ReadOnly TextProperty As DependencyProperty = DependencyProperty.Register("Text", GetType(String), GetType(MyIconTextButton), New PropertyMetadata(New PropertyChangedCallback( Public Shared ReadOnly TextProperty As DependencyProperty = DependencyProperty.Register("Text", GetType(String), GetType(MyIconTextButton), New PropertyMetadata(New PropertyChangedCallback(
Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs) Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs)
If Not IsNothing(sender) Then CType(sender, MyIconTextButton).LabText.Text = e.NewValue If Not IsNothing(sender) Then CType(sender, MyIconTextButton).LabText.Text = e.NewValue
End Sub))) End Sub)))
Public Enum ColorState Public Enum ColorState
Black Black
Highlight Highlight
End Enum End Enum
Private _ColorType As ColorState = ColorState.Black
Public Property ColorType As ColorState Public Property ColorType As ColorState
Get Get
Return _ColorType Return GetValue(ColorTypeProperty)
End Get End Get
Set(value As ColorState) Set(value As ColorState)
_ColorType = value If ColorType = value Then Return
SetValue(ColorTypeProperty, value)
RefreshColor() RefreshColor()
End Set End Set
End Property '颜色类别 End Property '颜色类别
Public Shared ReadOnly ColorTypeProperty As DependencyProperty = Public Shared ReadOnly ColorTypeProperty As DependencyProperty =
DependencyProperty.Register("ColorType", GetType(ColorState), GetType(MyIconTextButton), New PropertyMetadata()) DependencyProperty.Register("ColorType", GetType(ColorState), GetType(MyIconTextButton), New PropertyMetadata(ColorState.Black))
'点击事件 '点击事件
+189
View File
@@ -0,0 +1,189 @@
Public Class MyImage
Inherits Image
#Region "公开属性"
''' <summary>
''' 网络图片的缓存有效期。
''' 在这个时间后,才会重新尝试下载图片。
''' </summary>
Public FileCacheExpiredTime As New TimeSpan(7, 0, 0, 0) '7 天
''' <summary>
''' 是否允许将网络图片存储到本地用作缓存。
''' </summary>
Public Property EnableCache As Boolean
Get
Return GetValue(EnableCacheProperty)
End Get
Set(value As Boolean)
SetValue(EnableCacheProperty, value)
End Set
End Property
Public Shared Shadows ReadOnly EnableCacheProperty As DependencyProperty = DependencyProperty.Register(
"EnableCache", GetType(Boolean), GetType(MyImage), New PropertyMetadata(True))
''' <summary>
''' 与 Image 的 Source 类似。
''' 若输入以 http 开头的字符串,则会尝试下载图片然后显示,图片会保存为本地缓存。
''' 支持 WebP 格式的图片。
''' </summary>
Public Shadows Property Source As String '覆写 Image 的 Source 属性
Get
Return _Source
End Get
Set(value As String)
If value = "" Then value = Nothing
If _Source = value Then Exit Property
_Source = value
If Not IsInitialized Then Exit Property '属性读取顺序修正:在完成 XAML 属性读取后再触发图片加载(#4868)
Load()
End Set
End Property
Private _Source As String = ""
Public Shared Shadows ReadOnly SourceProperty As DependencyProperty = DependencyProperty.Register(
"Source", GetType(String), GetType(MyImage), New PropertyMetadata(New PropertyChangedCallback(
Sub(sender, e) If sender IsNot Nothing Then CType(sender, MyImage).Source = e.NewValue.ToString())))
''' <summary>
''' 当 Source 首次下载失败时,会从该备用地址加载图片。
''' </summary>
Public Property FallbackSource As String
Get
Return _FallbackSource
End Get
Set(value As String)
_FallbackSource = value
End Set
End Property
Private _FallbackSource As String = Nothing
''' <summary>
''' 正在下载网络图片时显示的本地图片。
''' </summary>
Public Property LoadingSource As String
Get
Return _LoadingSource
End Get
Set(value As String)
_LoadingSource = value
End Set
End Property
Private _LoadingSource As String = "pack://application:,,,/images/Icons/NoIcon.png"
#End Region
''' <summary>
''' 实际被呈现的图片地址。
''' </summary>
Public Property ActualSource As String
Get
Return _ActualSource
End Get
Set(value As String)
If value = "" Then value = Nothing
If _ActualSource = value Then Exit Property
_ActualSource = value
Try
Dim Bitmap As MyBitmap = If(value Is Nothing, Nothing, New MyBitmap(value)) '在这里先触发可能的文件读取,尽量避免在 UI 线程中读取文件
RunInUiWait(Sub() MyBase.Source = Bitmap)
Catch ex As Exception
Log(ex, $"加载图片失败({value})")
Try
If value.StartsWithF(PathTemp) AndAlso File.Exists(value) Then File.Delete(value)
Catch
End Try
End Try
End Set
End Property
Private _ActualSource As String = Nothing
Private Sub Load() _
Handles Me.Initialized '属性读取顺序修正:在完成 XAML 属性读取后再触发图片加载(#4868)
'空
If Source Is Nothing Then
ActualSource = Nothing
Exit Sub
End If
'本地图片
If Not Source.StartsWithF("http") Then
ActualSource = Source
Exit Sub
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
If EnableCache AndAlso TempFile.Exists Then
ActualSource = TempPath
If (Date.Now - TempFile.LastWriteTime) < FileCacheExpiredTime Then Exit Sub '无需刷新缓存
End If
RunInNewThread(
Sub()
Dim TempDownloadingPath As String = Nothing
Try
RetryStart:
'下载
ActualSource = LoadingSource '显示加载中图片
TempDownloadingPath = TempPath & RandomInteger(0, 10000000)
Directory.CreateDirectory(GetPathFromFullPath(TempPath)) '重新实现下载,以避免携带 Header(#5072)
Using Client As New Net.WebClient
Client.DownloadFile(Url, TempDownloadingPath)
End Using
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
Try
If TempPath IsNot Nothing Then File.Delete(TempPath)
If TempDownloadingPath IsNot Nothing Then File.Delete(TempDownloadingPath)
Catch
End Try
If Not Retried Then
'更换备用地址
Log(ex, $"下载图片可重试地失败({Url})", LogLevel.Developer)
Retried = True
Url = If(FallbackSource, Source)
'空
If Url Is Nothing Then
ActualSource = Nothing
Exit Sub
End If
'本地图片
If Not Url.StartsWithF("http") Then
ActualSource = Url
Exit Sub
End If
'从缓存加载网络图片
TempPath = GetTempPath(Url)
TempFile = New FileInfo(TempPath)
If EnableCache AndAlso TempFile.Exists() Then
ActualSource = TempPath
If (Date.Now - TempFile.CreationTime) < FileCacheExpiredTime Then Exit Sub '无需刷新缓存
End If
'下载
If Source = Url Then Thread.Sleep(1000) '延迟 1s 重试
GoTo RetryStart
Else
Log(ex, $"下载图片失败({Url})", LogLevel.Hint)
End If
End Try
End Sub, "MyImage PicLoader " & GetUuid() & "#", ThreadPriority.BelowNormal)
End Sub
Public Shared Function GetTempPath(Url As String) As String
Return $"{PathTemp}MyImage\{GetHash(Url)}.png"
End Function
End Class
@@ -1,4 +1,7 @@
Public Class MyListItem Imports System.Windows.Markup
<ContentProperty("Inlines")>
Public Class MyListItem
Implements IMyRadio Implements IMyRadio
Public Event Click(sender As Object, e As MouseButtonEventArgs) Public Event Click(sender As Object, e As MouseButtonEventArgs)
@@ -161,12 +164,17 @@
End Property End Property
'标题 '标题
Public ReadOnly Property Inlines As InlineCollection
Get
Return LabTitle.Inlines
End Get
End Property
Public Property Title As String Public Property Title As String
Get Get
Return GetValue(TitleProperty) Return GetValue(TitleProperty)
End Get End Get
Set(value As String) Set(value As String)
SetValue(TitleProperty, value) SetValue(TitleProperty, value.Replace(vbCr, "").Replace(vbLf, ""))
End Set End Set
End Property End Property
Public Shared ReadOnly TitleProperty As DependencyProperty = DependencyProperty.Register("Title", GetType(String), GetType(MyListItem)) Public Shared ReadOnly TitleProperty As DependencyProperty = DependencyProperty.Register("Title", GetType(String), GetType(MyListItem))
@@ -212,33 +220,26 @@
If Not _Logo = "" Then If Not _Logo = "" Then
If _Logo.StartsWithF("http", True) Then If _Logo.StartsWithF("http", True) Then
'网络图片 '网络图片
PathLogo = New Image With { PathLogo = New MyImage With {
.Tag = Me, .Tag = Me,
.IsHitTestVisible = LogoClickable, .IsHitTestVisible = LogoClickable,
.Source = New ImageSourceConverter().ConvertFromString(_Logo), .Source = _Logo,
.RenderTransformOrigin = New Point(0.5, 0.5), .RenderTransformOrigin = New Point(0.5, 0.5),
.RenderTransform = New ScaleTransform With {.ScaleX = LogoScale, .ScaleY = LogoScale}, .RenderTransform = New ScaleTransform With {.ScaleX = LogoScale, .ScaleY = LogoScale},
.SnapsToDevicePixels = True, .UseLayoutRounding = False} .SnapsToDevicePixels = True, .UseLayoutRounding = False}
RenderOptions.SetBitmapScalingMode(PathLogo, BitmapScalingMode.Linear) RenderOptions.SetBitmapScalingMode(PathLogo, BitmapScalingMode.Linear)
ElseIf _Logo.EndsWithF(".png", True) OrElse _Logo.EndsWithF(".jpg", True) Then ElseIf _Logo.EndsWithF(".png", True) OrElse _Logo.EndsWithF(".jpg", True) OrElse _Logo.EndsWithF(".webp", True) Then
'位图 '位图
Dim Bitmap = New MyBitmap(_Logo)
PathLogo = New Canvas With { PathLogo = New Canvas With {
.Tag = Me, .Tag = Me,
.IsHitTestVisible = LogoClickable, .IsHitTestVisible = LogoClickable,
.Background = Bitmap, .Background = New MyBitmap(_Logo),
.RenderTransformOrigin = New Point(0.5, 0.5), .RenderTransformOrigin = New Point(0.5, 0.5),
.RenderTransform = New ScaleTransform With {.ScaleX = LogoScale, .ScaleY = LogoScale}, .RenderTransform = New ScaleTransform With {.ScaleX = LogoScale, .ScaleY = LogoScale},
.SnapsToDevicePixels = True, .UseLayoutRounding = False} .SnapsToDevicePixels = True, .UseLayoutRounding = False,
'If Bitmap.Pic.Width = 16 AndAlso Bitmap.Pic.Height = 16 Then .HorizontalAlignment = HorizontalAlignment.Stretch, .VerticalAlignment = VerticalAlignment.Stretch
' '使用最适合 16x16 物品图片显示的大小 }
' RenderOptions.SetBitmapScalingMode(PathLogo, BitmapScalingMode.NearestNeighbor) RenderOptions.SetBitmapScalingMode(PathLogo, BitmapScalingMode.Linear)
' PathLogo.HorizontalAlignment = HorizontalAlignment.Center : PathLogo.VerticalAlignment = VerticalAlignment.Center
' PathLogo.Width = GetWPFSize(Math.Floor(GetPixelSize(32) / 16) * 16) : PathLogo.Height = PathLogo.Width
'Else
PathLogo.HorizontalAlignment = HorizontalAlignment.Stretch : PathLogo.VerticalAlignment = VerticalAlignment.Stretch
RenderOptions.SetBitmapScalingMode(PathLogo, BitmapScalingMode.HighQuality)
'End If
Else Else
'矢量图 '矢量图
PathLogo = New Shapes.Path With { PathLogo = New Shapes.Path With {
@@ -327,8 +328,8 @@
Private Sub OnSizeChanged() Handles Me.SizeChanged Private Sub OnSizeChanged() Handles Me.SizeChanged
ColumnCheck.Width = New GridLength(If(_Type = CheckType.None OrElse _Type = CheckType.Clickable, If(Height < 40, 4, 2), 6)) ColumnCheck.Width = New GridLength(If(_Type = CheckType.None OrElse _Type = CheckType.Clickable, If(Height < 40, 4, 2), 6))
ColumnLogo.Width = New GridLength(If(_Logo = "", 0, 34) + If(Height < 40, 0, 4)) ColumnLogo.Width = New GridLength(If(_Logo = "", 0, 34) + If(Height < 40, 0, 4))
If Not IsNothing(PathLogo) Then If PathLogo IsNot Nothing Then
If _Logo.EndsWithF(".png", True) Then If _Logo.EndsWithF(".png", True) OrElse _Logo.EndsWithF(".jpg", True) OrElse _Logo.EndsWithF(".webp", True) Then
PathLogo.Margin = New Thickness(4, 5, 3, 5) PathLogo.Margin = New Thickness(4, 5, 3, 5)
Else Else
PathLogo.Margin = New Thickness(If(Height < 40, 6, 8), 8, If(Height < 40, 4, 6), 8) PathLogo.Margin = New Thickness(If(Height < 40, 6, 8), 8, If(Height < 40, 4, 6), 8)
@@ -661,6 +662,8 @@
Dim Unused = New HelpEntry(GetEventAbsoluteUrls(EventData, EventType)(0)).SetToListItem(Me) Dim Unused = New HelpEntry(GetEventAbsoluteUrls(EventData, EventType)(0)).SetToListItem(Me)
Catch ex As Exception Catch ex As Exception
Log(ex, "设置帮助 MyListItem 失败", LogLevel.Msgbox) Log(ex, "设置帮助 MyListItem 失败", LogLevel.Msgbox)
EventType = Nothing
EventData = Nothing
End Try End Try
End If End If
End Sub End Sub
@@ -25,7 +25,7 @@
<TextBlock Grid.Row="0" FontSize="23" TextTrimming="None" Foreground="{DynamicResource ColorBrush2}" HorizontalAlignment="Left" Name="LabTitle" Margin="7,-1,70,9" Text="测试标题文本" VerticalAlignment="Top" SnapsToDevicePixels="False" UseLayoutRounding="False" /> <TextBlock Grid.Row="0" FontSize="23" TextTrimming="None" Foreground="{DynamicResource ColorBrush2}" HorizontalAlignment="Left" Name="LabTitle" Margin="7,-1,70,9" Text="测试标题文本" VerticalAlignment="Top" SnapsToDevicePixels="False" UseLayoutRounding="False" />
<Rectangle x:Name="ShapeLine" Grid.Row="1" Height="2" Fill="{Binding Foreground, ElementName=LabTitle}" /> <Rectangle x:Name="ShapeLine" Grid.Row="1" Height="2" Fill="{Binding Foreground, ElementName=LabTitle}" />
<my:MyScrollViewer Grid.Row="3" VerticalAlignment="Top" x:Name="PanText" Margin="0,0,0,7" Padding="7,0,15,0" <my:MyScrollViewer Grid.Row="3" VerticalAlignment="Top" x:Name="PanText" Margin="0,0,0,7" Padding="7,0,15,0"
VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" DeltaMuity="0.7"> VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" DeltaMult="0.7">
<TextBlock VerticalAlignment="Top" TextTrimming="None" TextWrapping="Wrap" Name="LabText" FontSize="15" LineHeight="18" <TextBlock VerticalAlignment="Top" TextTrimming="None" TextWrapping="Wrap" Name="LabText" FontSize="15" LineHeight="18"
Foreground="#FF5C5C5C" FontWeight="Normal" Padding="1" /> Foreground="#FF5C5C5C" FontWeight="Normal" Padding="1" />
</my:MyScrollViewer> </my:MyScrollViewer>
@@ -1,4 +1,4 @@
Public Class MyMsgInput Public Class MyMsgInput
Private ReadOnly MyConverter As MyMsgBoxConverter Private ReadOnly MyConverter As MyMsgBoxConverter
Private ReadOnly Uuid As Integer = GetUuid() Private ReadOnly Uuid As Integer = GetUuid()
@@ -72,7 +72,8 @@
End Sub End Sub
Public Sub Btn1_Click() Handles Btn1.Click Public Sub Btn1_Click() Handles Btn1.Click
If MyConverter.IsExited OrElse Not TextArea.ValidateResult = "" Then Exit Sub TextArea.Validate()
If MyConverter.IsExited OrElse Not TextArea.IsValidated Then Exit Sub
MyConverter.IsExited = True MyConverter.IsExited = True
MyConverter.Result = TextArea.Text MyConverter.Result = TextArea.Text
Close() Close()
@@ -85,7 +86,7 @@
End Sub End Sub
Private Sub TextCaption_ValidateChanged(sender As Object, e As EventArgs) Handles TextArea.ValidateChanged Private Sub TextCaption_ValidateChanged(sender As Object, e As EventArgs) Handles TextArea.ValidateChanged
Btn1.IsEnabled = TextArea.ValidateResult = "" Btn1.IsEnabled = TextArea.IsValidated
End Sub End Sub
Private Sub Drag(sender As Object, e As MouseButtonEventArgs) Handles PanBorder.MouseLeftButtonDown, LabTitle.MouseLeftButtonDown Private Sub Drag(sender As Object, e As MouseButtonEventArgs) Handles PanBorder.MouseLeftButtonDown, LabTitle.MouseLeftButtonDown
@@ -24,7 +24,7 @@
<TextBlock Grid.Row="0" FontSize="23" TextTrimming="None" Foreground="{DynamicResource ColorBrush2}" HorizontalAlignment="Left" Name="LabTitle" Margin="7,-1,70,9" Text="测试标题文本" VerticalAlignment="Top" SnapsToDevicePixels="False" UseLayoutRounding="False" /> <TextBlock Grid.Row="0" FontSize="23" TextTrimming="None" Foreground="{DynamicResource ColorBrush2}" HorizontalAlignment="Left" Name="LabTitle" Margin="7,-1,70,9" Text="测试标题文本" VerticalAlignment="Top" SnapsToDevicePixels="False" UseLayoutRounding="False" />
<Rectangle x:Name="ShapeLine" Grid.Row="1" Height="2" Fill="{Binding Foreground, ElementName=LabTitle}" /> <Rectangle x:Name="ShapeLine" Grid.Row="1" Height="2" Fill="{Binding Foreground, ElementName=LabTitle}" />
<my:MyScrollViewer Grid.Row="3" VerticalAlignment="Top" x:Name="PanCaption" Margin="0,0,0,17" Padding="7,0,15,0" <my:MyScrollViewer Grid.Row="3" VerticalAlignment="Top" x:Name="PanCaption" Margin="0,0,0,17" Padding="7,0,15,0"
VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" DeltaMuity="0.7"> VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" DeltaMult="0.7">
<StackPanel x:Name="PanSelection" Orientation="Vertical" /> <StackPanel x:Name="PanSelection" Orientation="Vertical" />
</my:MyScrollViewer> </my:MyScrollViewer>
<StackPanel Grid.Row="4" Name="PanBtn" VerticalAlignment="Top" HorizontalAlignment="Right" Margin="150,0,8,0" Orientation="Horizontal"> <StackPanel Grid.Row="4" Name="PanBtn" VerticalAlignment="Top" HorizontalAlignment="Right" Margin="150,0,8,0" Orientation="Horizontal">
@@ -24,7 +24,7 @@
<TextBlock Grid.Row="0" FontSize="23" TextTrimming="None" Foreground="{DynamicResource ColorBrush2}" HorizontalAlignment="Left" Name="LabTitle" Margin="7,-1,70,9" Text="测试标题文本" VerticalAlignment="Top" SnapsToDevicePixels="False" UseLayoutRounding="False" /> <TextBlock Grid.Row="0" FontSize="23" TextTrimming="None" Foreground="{DynamicResource ColorBrush2}" HorizontalAlignment="Left" Name="LabTitle" Margin="7,-1,70,9" Text="测试标题文本" VerticalAlignment="Top" SnapsToDevicePixels="False" UseLayoutRounding="False" />
<Rectangle x:Name="ShapeLine" Grid.Row="1" Height="2" Fill="{Binding Foreground, ElementName=LabTitle}" /> <Rectangle x:Name="ShapeLine" Grid.Row="1" Height="2" Fill="{Binding Foreground, ElementName=LabTitle}" />
<my:MyScrollViewer Grid.Row="3" VerticalAlignment="Top" x:Name="PanCaption" Margin="0,0,0,17" Padding="7,0,15,0" <my:MyScrollViewer Grid.Row="3" VerticalAlignment="Top" x:Name="PanCaption" Margin="0,0,0,17" Padding="7,0,15,0"
VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" DeltaMuity="0.7"> VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" DeltaMult="0.7">
<TextBlock VerticalAlignment="Top" TextTrimming="None" TextWrapping="Wrap" Name="LabCaption" FontSize="15" LineHeight="18" <TextBlock VerticalAlignment="Top" TextTrimming="None" TextWrapping="Wrap" Name="LabCaption" FontSize="15" LineHeight="18"
Foreground="#FF5C5C5C" FontWeight="Normal" Padding="1" /> Foreground="#FF5C5C5C" FontWeight="Normal" Padding="1" />
</my:MyScrollViewer> </my:MyScrollViewer>
@@ -104,3 +104,7 @@
End Sub End Sub
End Class End Class
Public Interface IRefreshable
Sub Refresh()
End Interface
+39 -24
View File
@@ -353,12 +353,16 @@
If Control.RenderTransform IsNot Nothing AndAlso TypeOf Control.RenderTransform Is TranslateTransform Then Control.RenderTransform = Nothing If Control.RenderTransform IsNot Nothing AndAlso TypeOf Control.RenderTransform Is TranslateTransform Then Control.RenderTransform = Nothing
Next Next
For Each Control As FrameworkElement In GetAllAnimControls(Element) For Each Control As FrameworkElement In GetAllAnimControls(Element)
Control.Opacity = 0 If TypeOf Control Is MyExtraTextButton Then
Control.RenderTransform = New TranslateTransform(0, -16) CType(Control, MyExtraTextButton).Show = True
AniList.Add(AaOpacity(Control, 1, 150, Delay, New AniEaseOutFluent(AniEasePower.Weak))) Else
AniList.Add(AaTranslateY(Control, 5, 250, Delay, New AniEaseOutFluent)) Control.Opacity = 0
AniList.Add(AaTranslateY(Control, 11, 350, Delay, New AniEaseOutBack)) Control.RenderTransform = New TranslateTransform(0, -16)
Delay += 40 AniList.Add(AaOpacity(Control, 1, 150, Delay, New AniEaseOutFluent(AniEasePower.Weak)))
AniList.Add(AaTranslateY(Control, 5, 250, Delay, New AniEaseOutFluent))
AniList.Add(AaTranslateY(Control, 11, 350, Delay, New AniEaseOutBack))
Delay += 40
End If
Next Next
Next Next
'滚动条动画 '滚动条动画
@@ -379,10 +383,14 @@
Dim Delay As Integer = 0 Dim Delay As Integer = 0
For Each Element In RealElements For Each Element In RealElements
For Each Control As FrameworkElement In GetAllAnimControls(Element) For Each Control As FrameworkElement In GetAllAnimControls(Element)
Control.IsHitTestVisible = False If TypeOf Control Is MyExtraTextButton Then
AniList.Add(AaOpacity(Control, -1, 90, Delay)) CType(Control, MyExtraTextButton).Show = False
AniList.Add(AaTranslateY(Control, -6, 90, Delay)) Else
Delay += 20 Control.IsHitTestVisible = False
AniList.Add(AaOpacity(Control, -1, 90, Delay))
AniList.Add(AaTranslateY(Control, -6, 90, Delay))
Delay += 20
End If
Next Next
Next Next
'滚动条动画 '滚动条动画
@@ -392,31 +400,38 @@
AniList.Add(AaTranslateX(Scroll, 10 - CType(Scroll.RenderTransform, TranslateTransform).X, 90, 0, New AniEaseInFluent)) AniList.Add(AaTranslateX(Scroll, 10 - CType(Scroll.RenderTransform, TranslateTransform).X, 90, 0, New AniEaseInFluent))
End If End If
'结束 '结束
AniList.Add(AaCode(Sub() AniList.Add(AaCode(
For Each Element In RealElements Sub()
Element.Visibility = Visibility.Collapsed For Each Element In RealElements
Next Element.Visibility = Visibility.Collapsed
PageOnExitAnimationFinished() Next
End Sub,, True)) PageOnExitAnimationFinished()
End Sub,, True))
AniStart(AniList, "PageRight PageChange " & PageUuid) AniStart(AniList, "PageRight PageChange " & PageUuid)
End Sub End Sub
'遍历获取所有需要生成动画的控件 ''' <summary>
Friend Function GetAllAnimControls(Element As FrameworkElement, Optional IgnoreInvisibility As Boolean = False) As List(Of FrameworkElement) ''' 禁用页面切换动画的控件列表。
''' </summary>
Public DisabledPageAnimControls As New List(Of FrameworkElement)
''' <summary>
''' 遍历获取所有需要生成动画的控件。
''' </summary>
Friend Function GetAllAnimControls(Element As FrameworkElement, Optional IgnoreInvisibility As Boolean = False) As IEnumerable(Of FrameworkElement)
Dim AllControls As New List(Of FrameworkElement) Dim AllControls As New List(Of FrameworkElement)
GetAllAnimControls(Element, AllControls, IgnoreInvisibility) _GetAllAnimControls(Element, AllControls, IgnoreInvisibility)
Return AllControls Return AllControls.Except(DisabledPageAnimControls)
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)
If Not IgnoreInvisibility AndAlso Element.Visibility = Visibility.Collapsed Then Exit Sub If Not IgnoreInvisibility AndAlso Element.Visibility = Visibility.Collapsed Then Exit Sub
If TypeOf Element Is MyCard OrElse TypeOf Element Is MyHint OrElse TypeOf Element Is TextBlock OrElse TypeOf Element Is MyTextButton Then If TypeOf Element Is MyCard OrElse TypeOf Element Is MyHint OrElse TypeOf Element Is MyExtraTextButton OrElse TypeOf Element Is TextBlock OrElse TypeOf Element Is MyTextButton Then
AllControls.Add(Element) AllControls.Add(Element)
ElseIf TypeOf Element Is ContentControl Then ElseIf TypeOf Element Is ContentControl Then
Dim Content = CType(Element, ContentControl).Content Dim Content = CType(Element, ContentControl).Content
If Content IsNot Nothing AndAlso TypeOf Content Is FrameworkElement Then GetAllAnimControls(Content, AllControls, IgnoreInvisibility) If Content IsNot Nothing AndAlso TypeOf Content Is FrameworkElement Then _GetAllAnimControls(Content, AllControls, IgnoreInvisibility)
ElseIf TypeOf Element Is Panel Then ElseIf TypeOf Element Is Panel Then
For Each Element2 In CType(Element, Panel).Children For Each Element2 In CType(Element, Panel).Children
If TypeOf Element2 Is FrameworkElement Then GetAllAnimControls(Element2, AllControls, IgnoreInvisibility) If TypeOf Element2 Is FrameworkElement Then _GetAllAnimControls(Element2, AllControls, IgnoreInvisibility)
Next Next
End If End If
End Sub End Sub
@@ -3,7 +3,7 @@
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
FocusVisualStyle="{x:Null}" FocusVisualStyle="{x:Null}"
MinWidth="20" x:Name="PanBack" UseLayoutRounding="False" SnapsToDevicePixels="False" MinHeight="20" Background="{StaticResource ColorBrushSemiTransparent}" Focusable="True"> MinWidth="20" x:Name="PanBack" UseLayoutRounding="False" SnapsToDevicePixels="False" MinHeight="20" Background="{StaticResource ColorBrushSemiTransparent}" Focusable="True">
<TextBlock IsHitTestVisible="False" x:Name="LabText" FontSize="13" Padding="0" Margin="26,0,0,0" Text="Radiobox" Foreground="{DynamicResource ColorBrush1}" HorizontalAlignment="Left" VerticalAlignment="Center"/> <TextBlock IsHitTestVisible="False" x:Name="LabText" FontSize="13" Padding="0" Margin="26,0,0,0" Foreground="{DynamicResource ColorBrush1}" HorizontalAlignment="Left" VerticalAlignment="Center"/>
<Ellipse IsHitTestVisible="False" x:Name="ShapeBorder" StrokeThickness="1.1" HorizontalAlignment="Left" VerticalAlignment="Center" Width="18" Height="18" Stroke="{DynamicResource ColorBrush1}" Margin="1,0,0,0" Fill="{StaticResource ColorBrushHalfWhite}" /> <Ellipse IsHitTestVisible="False" x:Name="ShapeBorder" StrokeThickness="1.1" HorizontalAlignment="Left" VerticalAlignment="Center" Width="18" Height="18" Stroke="{DynamicResource ColorBrush1}" Margin="1,0,0,0" Fill="{StaticResource ColorBrushHalfWhite}" />
<Ellipse IsHitTestVisible="False" x:Name="ShapeDot" HorizontalAlignment="Left" VerticalAlignment="Center" Fill="{Binding Stroke, ElementName=ShapeBorder}" Width="0" Height="0" Margin="10,0,0,0" StrokeThickness="0" /> <Ellipse IsHitTestVisible="False" x:Name="ShapeDot" HorizontalAlignment="Left" VerticalAlignment="Center" Fill="{Binding Stroke, ElementName=ShapeBorder}" Width="0" Height="0" Margin="10,0,0,0" StrokeThickness="0" />
</Grid> </Grid>
@@ -1,4 +1,7 @@
Public Class MyRadioBox Imports System.Windows.Markup
<ContentProperty("Inlines")>
Public Class MyRadioBox
Implements IMyRadio Implements IMyRadio
'基础 '基础
@@ -10,27 +13,29 @@
Public Event Changed(sender As Object, e As RouteEventArgs) Implements IMyRadio.Changed Public Event Changed(sender As Object, e As RouteEventArgs) Implements IMyRadio.Changed
'自定义属性 '自定义属性
Private _Checked As Boolean = False '是否选中
Public Property Checked As Boolean Public Property Checked As Boolean
Get Get
Return _Checked Return GetValue(CheckedProperty)
End Get End Get
Set(value As Boolean) Set(value As Boolean)
SetChecked(value, False, True) SetChecked(value, False)
End Set End Set
End Property End Property
Public Shared ReadOnly CheckedProperty As DependencyProperty =
DependencyProperty.Register("Checked", GetType(Boolean), GetType(MyRadioBox), New PropertyMetadata(False,
Sub(d As MyRadioBox, e As DependencyPropertyChangedEventArgs)
'在使用 XAML 设置 Checked 属性时,不会触发 Checked_Set 方法,所以需要在这里手动触发 UI 改变
If Not d.IsLoaded Then d.SyncUI()
End Sub))
''' <summary> ''' <summary>
''' 手动设置 Checked 属性。 ''' 手动设置 Checked 属性。
''' </summary> ''' </summary>
''' <param name="value">新的 Checked 属性。</param> ''' <param name="value">新的 Checked 属性。</param>
''' <param name="user">是否由用户引发。</param> ''' <param name="user">是否由用户引发。</param>
''' <param name="anime">是否执行动画。</param> Public Sub SetChecked(value As Boolean, user As Boolean)
Public Sub SetChecked(value As Boolean, user As Boolean, anime As Boolean)
Try Try
'Preview 事件 'Preview 事件
If value AndAlso user Then If value AndAlso user Then
Dim e = New RouteEventArgs(user) Dim e = New RouteEventArgs(user)
RaiseEvent PreviewCheck(Me, e) RaiseEvent PreviewCheck(Me, e)
@@ -41,28 +46,24 @@
End If End If
'自定义属性基础 '自定义属性基础
Dim IsChanged As Boolean = False Dim IsChanged As Boolean = False
If IsLoaded AndAlso Not value = _Checked Then RaiseEvent PreviewChange(Me, New RouteEventArgs(user)) If IsLoaded AndAlso Not value = Checked Then RaiseEvent PreviewChange(Me, New RouteEventArgs(user))
If Not value = _Checked Then If Not value = Checked Then
_Checked = value SetValue(CheckedProperty, value)
IsChanged = True IsChanged = True
End If End If
'保证只有一个单选框选中 '保证只有一个单选框选中
If Parent Is Nothing Then Exit Sub If Parent Is Nothing Then Exit Sub
Dim RadioboxList As New List(Of MyRadioBox) Dim RadioboxList As New List(Of MyRadioBox)
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
If TypeOf Control Is MyRadioBox Then If TypeOf Control Is MyRadioBox Then
RadioboxList.Add(Control) RadioboxList.Add(Control)
If Control.Checked Then CheckedCount += 1 If Control.Checked Then CheckedCount += 1
End If End If
Next Next
'判断选中情况 Select Case CheckedCount '判断选中情况
Select Case CheckedCount
Case 0 Case 0
'没有任何单选框被选中,选择第一个 '没有任何单选框被选中,选择第一个
RadioboxList(0).Checked = True RadioboxList(0).Checked = True
@@ -87,67 +88,74 @@
Next Next
End If End If
End Select End Select
'End If
'更改动画
If Not IsChanged Then Exit Sub
If IsLoaded AndAlso AniControlEnabled = 0 AndAlso anime Then '防止默认属性变更触发动画
If Checked Then
'由无变有
If ShapeDot.Opacity < 0.01 Then ShapeDot.Opacity = 1
AniStart({
AaScale(ShapeBorder, 10 - ShapeBorder.Width, AnimationTimeOfCheck, , New AniEaseOutFluent(AniEasePower.Weak), , True),
AaScale(ShapeBorder, 8, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.6, New AniEaseOutBack, , True)
}, "MyRadioBox Border " & Uuid)
AniStart({
AaScale(ShapeDot, 9 - ShapeDot.Width, AnimationTimeOfCheck * 2.6,, New AniEaseOutBack(AniEasePower.Weak), , True),
AaOpacity(ShapeDot, 1 - ShapeDot.Opacity, AnimationTimeOfCheck * 0.5, AnimationTimeOfCheck * 0.6)
}, "MyRadioBox Dot " & Uuid)
AniStart({
AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsMouseOver, "ColorBrush3", If(IsEnabled, "ColorBrush2", "ColorBrushGray4")), AnimationTimeOfCheck)
}, "MyRadioBox BorderColor " & Uuid)
Else
'由有变无
AniStart({
AaScale(ShapeBorder, 18 - ShapeBorder.Width, AnimationTimeOfCheck, , New AniEaseOutFluent, , True)
}, "MyRadioBox Border " & Uuid)
AniStart({
AaScale(ShapeDot, -ShapeDot.Width, AnimationTimeOfCheck, , New AniEaseInFluent, , True),
AaOpacity(ShapeDot, -ShapeDot.Opacity, AnimationTimeOfCheck * 0.5, AnimationTimeOfCheck * 0.2)
}, "MyRadioBox Dot " & Uuid)
AniStart({
AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsMouseOver, "ColorBrush3", If(IsEnabled, "ColorBrush1", "ColorBrushGray4")), AnimationTimeOfCheck)
}, "MyRadioBox BorderColor " & Uuid)
End If
Else
'不使用动画
AniStop("MyRadioBox Border " & Uuid)
AniStop("MyRadioBox Dot " & Uuid)
AniStop("MyRadioBox BorderColor " & Uuid)
If Checked Then
ShapeDot.Width = 9
ShapeDot.Height = 9
ShapeDot.Opacity = 1
ShapeDot.Margin = New Thickness(5.5, 0, 0, 0)
ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, "ColorBrush2", "ColorBrushGray4"))
Else
ShapeDot.Width = 0
ShapeDot.Height = 0
ShapeDot.Opacity = 0
ShapeDot.Margin = New Thickness(10, 0, 0, 0)
ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4"))
End If
End If
'触发事件 '触发事件
If Checked Then RaiseEvent Check(Me, New RouteEventArgs(user)) If IsChanged Then
RaiseEvent Changed(Me, New RouteEventArgs(user)) If Checked Then RaiseEvent Check(Me, New RouteEventArgs(user))
RaiseEvent Changed(Me, New RouteEventArgs(user))
End If
'更改动画
SyncUI()
Catch ex As Exception Catch ex As Exception
Log(ex, "单选框勾选改变错误", LogLevel.Hint) Log(ex, "单选框勾选改变错误", LogLevel.Hint)
End Try End Try
End Sub End Sub
Private Sub SyncUI()
If AniControlEnabled = 0 AndAlso IsLoaded Then '防止默认属性变更触发动画
If Checked Then
'由无变有
If ShapeDot.Opacity < 0.01 Then ShapeDot.Opacity = 1
AniStart({
AaScale(ShapeBorder, 10 - ShapeBorder.Width, AnimationTimeOfCheck, , New AniEaseOutFluent(AniEasePower.Weak), , True),
AaScale(ShapeBorder, 8, AnimationTimeOfCheck * 2, AnimationTimeOfCheck * 0.6, New AniEaseOutBack, , True)
}, "MyRadioBox Border " & Uuid)
AniStart({
AaScale(ShapeDot, 9 - ShapeDot.Width, AnimationTimeOfCheck * 2.6,, New AniEaseOutBack(AniEasePower.Weak), , True),
AaOpacity(ShapeDot, 1 - ShapeDot.Opacity, AnimationTimeOfCheck * 0.5, AnimationTimeOfCheck * 0.6)
}, "MyRadioBox Dot " & Uuid)
AniStart({
AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsMouseOver, "ColorBrush3", If(IsEnabled, "ColorBrush2", "ColorBrushGray4")), AnimationTimeOfCheck)
}, "MyRadioBox BorderColor " & Uuid)
Else
'由有变无
AniStart({
AaScale(ShapeBorder, 18 - ShapeBorder.Width, AnimationTimeOfCheck, , New AniEaseOutFluent, , True)
}, "MyRadioBox Border " & Uuid)
AniStart({
AaScale(ShapeDot, -ShapeDot.Width, AnimationTimeOfCheck, , New AniEaseInFluent, , True),
AaOpacity(ShapeDot, -ShapeDot.Opacity, AnimationTimeOfCheck * 0.5, AnimationTimeOfCheck * 0.2)
}, "MyRadioBox Dot " & Uuid)
AniStart({
AaColor(ShapeBorder, Ellipse.StrokeProperty, If(IsMouseOver, "ColorBrush3", If(IsEnabled, "ColorBrush1", "ColorBrushGray4")), AnimationTimeOfCheck)
}, "MyRadioBox BorderColor " & Uuid)
End If
Else
'不使用动画
AniStop("MyRadioBox Border " & Uuid)
AniStop("MyRadioBox Dot " & Uuid)
AniStop("MyRadioBox BorderColor " & Uuid)
If Checked Then
ShapeDot.Width = 9
ShapeDot.Height = 9
ShapeDot.Opacity = 1
ShapeDot.Margin = New Thickness(5.5, 0, 0, 0)
ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, "ColorBrush2", "ColorBrushGray4"))
Else
ShapeDot.Width = 0
ShapeDot.Height = 0
ShapeDot.Opacity = 0
ShapeDot.Margin = New Thickness(10, 0, 0, 0)
ShapeBorder.SetResourceReference(Ellipse.StrokeProperty, If(IsEnabled, "ColorBrush1", "ColorBrushGray4"))
End If
End If
End Sub
Public ReadOnly Property Inlines As InlineCollection
Get
Return LabText.Inlines
End Get
End Property
Public Property Text As String Public Property Text As String
Get Get
Return GetValue(TextProperty) Return GetValue(TextProperty)
@@ -157,9 +165,7 @@
End Set End Set
End Property '内容 End Property '内容
Public Shared ReadOnly TextProperty As DependencyProperty = DependencyProperty.Register("Text", GetType(String), GetType(MyRadioBox), New PropertyMetadata(New PropertyChangedCallback( Public Shared ReadOnly TextProperty As DependencyProperty = DependencyProperty.Register("Text", GetType(String), GetType(MyRadioBox), New PropertyMetadata(New PropertyChangedCallback(
Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs) Sub(sender, e) If sender IsNot Nothing Then CType(sender, MyRadioBox).LabText.Text = e.NewValue)))
If Not IsNothing(sender) Then CType(sender, MyRadioBox).LabText.Text = e.NewValue
End Sub)))
'点击事件 '点击事件
@@ -167,9 +173,9 @@
Private AllowMouseDown As Boolean = True Private AllowMouseDown As Boolean = True
Private Sub Radiobox_MouseUp() Handles Me.MouseLeftButtonUp Private Sub Radiobox_MouseUp() Handles Me.MouseLeftButtonUp
If Not MouseDowned Then Exit Sub If Not MouseDowned Then Exit Sub
MouseDowned = False
Log("[Control] 按下单选框:" & Text) Log("[Control] 按下单选框:" & Text)
SetChecked(True, True, True) SetChecked(True, True)
MouseDowned = False
AniStart(AaColor(ShapeBorder, Ellipse.FillProperty, "ColorBrushHalfWhite", 100), "MyRadioBox Background " & Uuid) AniStart(AaColor(ShapeBorder, Ellipse.FillProperty, "ColorBrushHalfWhite", 100), "MyRadioBox Background " & Uuid)
End Sub End Sub
Private Sub Radiobox_MouseDown() Handles Me.MouseLeftButtonDown Private Sub Radiobox_MouseDown() Handles Me.MouseLeftButtonDown
@@ -4,6 +4,6 @@
HorizontalAlignment="Center" VerticalAlignment="Center" Background="{StaticResource ColorBrushSemiTransparent}" CornerRadius="13.5" MinHeight="27" MaxHeight="27"> HorizontalAlignment="Center" VerticalAlignment="Center" Background="{StaticResource ColorBrushSemiTransparent}" CornerRadius="13.5" MinHeight="27" MaxHeight="27">
<StackPanel Orientation="Horizontal"> <StackPanel Orientation="Horizontal">
<Path x:Name="ShapeLogo" HorizontalAlignment="Left" RenderTransformOrigin="0.5,0.5" Margin="12,0,0,0" Stretch="Uniform" Fill="White" MaxHeight="16" MaxWidth="16" VerticalAlignment="Center" /> <Path x:Name="ShapeLogo" HorizontalAlignment="Left" RenderTransformOrigin="0.5,0.5" Margin="12,0,0,0" Stretch="Uniform" Fill="White" MaxHeight="16" MaxWidth="16" VerticalAlignment="Center" />
<TextBlock x:Name="LabText" VerticalAlignment="Center" Grid.Column="1" Foreground="White" Margin="8,0,12,1" Grid.ColumnSpan="2" SnapsToDevicePixels="False" UseLayoutRounding="False" /> <TextBlock x:Name="LabText" VerticalAlignment="Center" Grid.Column="1" Foreground="White" Margin="8,0,12,0" Grid.ColumnSpan="2" SnapsToDevicePixels="False" UseLayoutRounding="False" />
</StackPanel> </StackPanel>
</Border> </Border>
@@ -1,4 +1,7 @@
Public Class MyRadioButton Imports System.Windows.Markup
<ContentProperty("Inlines")>
Public Class MyRadioButton
'基础 '基础
@@ -108,6 +111,12 @@
Log(ex, "单选按钮勾选改变错误", LogLevel.Hint) Log(ex, "单选按钮勾选改变错误", LogLevel.Hint)
End Try End Try
End Sub End Sub
Public ReadOnly Property Inlines As InlineCollection
Get
Return LabText.Inlines
End Get
End Property
Public Property Text As String Public Property Text As String
Get Get
Return GetValue(TextProperty) Return GetValue(TextProperty)
@@ -117,9 +126,7 @@
End Set End Set
End Property '内容 End Property '内容
Public Shared ReadOnly TextProperty As DependencyProperty = DependencyProperty.Register("Text", GetType(String), GetType(MyRadioButton), New PropertyMetadata(New PropertyChangedCallback( Public Shared ReadOnly TextProperty As DependencyProperty = DependencyProperty.Register("Text", GetType(String), GetType(MyRadioButton), New PropertyMetadata(New PropertyChangedCallback(
Sub(sender As DependencyObject, e As DependencyPropertyChangedEventArgs) Sub(sender, e) If sender IsNot Nothing Then CType(sender, MyRadioButton).LabText.Text = e.NewValue)))
If Not IsNothing(sender) Then CType(sender, MyRadioButton).LabText.Text = e.NewValue
End Sub)))
Public Enum ColorState Public Enum ColorState
White White
Highlight Highlight
+2 -1
View File
@@ -301,7 +301,7 @@ Public Class MyResizer
End Sub End Sub
Private Sub updateMouseDown() Private Sub updateMouseDown()
Dim flag As Boolean = Mouse.LeftButton = MouseButtonState.Released Dim flag = (GetAsyncKeyState(&H1) And &H8000) = 0 '调用原生API判断鼠标是否抬起,如果使用WPF的API的话鼠标不在窗口上时不会更新状态 (#5655)
If flag Then If flag Then
resizeRight = False resizeRight = False
resizeLeft = False resizeLeft = False
@@ -312,4 +312,5 @@ Public Class MyResizer
Private Declare Function GetCursorPos Lib "user32.dll" (<Out()> ByRef lpPoint As PointAPI) As Boolean Private Declare Function GetCursorPos Lib "user32.dll" (<Out()> ByRef lpPoint As PointAPI) As Boolean
Private Declare Function GetAsyncKeyState Lib "user32.dll" (vKey As Integer) As Short
End Class End Class
@@ -1,7 +1,7 @@
Public Class MyScrollViewer Public Class MyScrollViewer
Inherits ScrollViewer Inherits ScrollViewer
Public Property DeltaMuity As Double = 1 Public Property DeltaMult As Double = 1
Private RealOffset As Double Private RealOffset As Double
@@ -25,10 +25,12 @@
Next Next
End Sub End Sub
Public Sub PerformVerticalOffsetDelta(Delta As Double) Public Sub PerformVerticalOffsetDelta(Delta As Double)
AniStart(AaDouble(Sub(AnimDelta As Double) AniStart(
RealOffset = MathClamp(RealOffset + AnimDelta, 0, ExtentHeight - ActualHeight) AaDouble(
ScrollToVerticalOffset(RealOffset) Sub(AnimDelta As Double)
End Sub, Delta * DeltaMuity, 300,, New AniEaseOutFluent(6))) RealOffset = MathClamp(RealOffset + AnimDelta, 0, ExtentHeight - ActualHeight)
ScrollToVerticalOffset(RealOffset)
End Sub, Delta * DeltaMult, 300,, New AniEaseOutFluent(6)))
End Sub End Sub
Private Sub MyScrollViewer_ScrollChanged(sender As Object, e As ScrollChangedEventArgs) Handles Me.ScrollChanged Private Sub MyScrollViewer_ScrollChanged(sender As Object, e As ScrollChangedEventArgs) Handles Me.ScrollChanged
RealOffset = VerticalOffset RealOffset = VerticalOffset
@@ -43,4 +45,7 @@
ScrollBar = GetTemplateChild("PART_VerticalScrollBar") ScrollBar = GetTemplateChild("PART_VerticalScrollBar")
End Sub End Sub
Private Sub MyScrollViewer_PreviewGotKeyboardFocus(sender As Object, e As KeyboardFocusChangedEventArgs) Handles Me.PreviewGotKeyboardFocus
If e.NewFocus IsNot Nothing AndAlso TypeOf e.NewFocus Is MySlider Then e.Handled = True '#3854,阻止获得焦点时自动滚动
End Sub
End Class End Class
@@ -8,7 +8,7 @@
d:DesignHeight="450" d:DesignWidth="800" d:DesignHeight="450" d:DesignWidth="800"
Height="40"> Height="40">
<Grid> <Grid>
<local:MyTextBox HasAnimation="False" x:Name="TextBox" BorderThickness="0" Padding="32,0,40,0" MaxLength="50" FontSize="13.5" UseLayoutRounding="False" SnapsToDevicePixels="False" VerticalContentAlignment="Center" /> <local:MyTextBox HasBackground="False" x:Name="TextBox" BorderThickness="0" Padding="32,0,40,0" MaxLength="50" FontSize="13.5" UseLayoutRounding="False" SnapsToDevicePixels="False" VerticalContentAlignment="Center" />
<Path Width="14" Margin="14,0,0,0" IsHitTestVisible="False" Height="14" Fill="{DynamicResource ColorBrush1}" Stretch="Uniform" Data="M675.9168 242.816C556.3008 123.2 362.4448 123.2 242.8288 242.816 123.2128 362.432 123.2128 556.288 242.8288 675.904 362.4448 795.52 556.3008 795.52 675.9168 675.904 795.5328 556.288 795.5328 362.432 675.9168 242.816L675.9168 242.816ZM1000.7168 892.48C1030.6048 922.368 1030.6048 970.816 1000.7168 1000.704 970.8288 1030.656 922.3808 1030.656 892.4288 1000.704L730.0608 838.336C728.1408 836.416 727.4368 833.92 725.7728 831.872 546.3168 960.448 295.7568 945.408 134.5408 784.192-44.8512 604.8-44.8512 313.92 134.5408 134.528 313.9328-44.864 604.8128-44.864 784.2048 134.528 945.4208 295.744 960.4608 546.304 831.8848 725.76 833.9328 727.424 836.4288 728.128 838.3488 730.048L1000.7168 892.48Z" HorizontalAlignment="Left" /> <Path Width="14" Margin="14,0,0,0" IsHitTestVisible="False" Height="14" Fill="{DynamicResource ColorBrush1}" Stretch="Uniform" Data="M675.9168 242.816C556.3008 123.2 362.4448 123.2 242.8288 242.816 123.2128 362.432 123.2128 556.288 242.8288 675.904 362.4448 795.52 556.3008 795.52 675.9168 675.904 795.5328 556.288 795.5328 362.432 675.9168 242.816L675.9168 242.816ZM1000.7168 892.48C1030.6048 922.368 1030.6048 970.816 1000.7168 1000.704 970.8288 1030.656 922.3808 1030.656 892.4288 1000.704L730.0608 838.336C728.1408 836.416 727.4368 833.92 725.7728 831.872 546.3168 960.448 295.7568 945.408 134.5408 784.192-44.8512 604.8-44.8512 313.92 134.5408 134.528 313.9328-44.864 604.8128-44.864 784.2048 134.528 945.4208 295.744 960.4608 546.304 831.8848 725.76 833.9328 727.424 836.4288 728.128 838.3488 730.048L1000.7168 892.48Z" HorizontalAlignment="Left" />
<local:MyIconButton x:Name="BtnClear" IsHitTestVisible="False" Opacity="0" Width="24" Margin="0,0,10,0" LogoScale="0.75" Height="24" Logo="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" HorizontalAlignment="Right" Theme="Black" /> <local:MyIconButton x:Name="BtnClear" IsHitTestVisible="False" Opacity="0" Width="24" Margin="0,0,10,0" LogoScale="0.75" Height="24" Logo="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" HorizontalAlignment="Right" Theme="Black" />
</Grid> </Grid>
+72 -44
View File
@@ -3,8 +3,18 @@
'自定义属性 '自定义属性
Public Property HasAnimation As Boolean = True Public Property HasBackground As Boolean = True
Public Property ShowValidateResult As Boolean = True Public Property ShowValidateResult As Boolean = True
Public Property CornerRadius As CornerRadius
Get
Return GetValue(CornerRadiusProperty)
End Get
Set(value As CornerRadius)
SetValue(CornerRadiusProperty, value)
End Set
End Property
Public Shared ReadOnly CornerRadiusProperty As DependencyProperty =
DependencyProperty.Register("CornerRadius", GetType(CornerRadius), GetType(MyTextBox), New PropertyMetadata(New CornerRadius(3)))
'额外控件初始化 '额外控件初始化
@@ -62,7 +72,24 @@
SetValue(ValidateResultProperty, value) SetValue(ValidateResultProperty, value)
End Set End Set
End Property End Property
Public Shared ReadOnly ValidateResultProperty As DependencyProperty = DependencyProperty.Register("ValidateResult", GetType(String), GetType(MyTextBox), New PropertyMetadata("")) Public Shared ReadOnly ValidateResultProperty As DependencyProperty =
DependencyProperty.Register("ValidateResult", GetType(String), GetType(MyTextBox), New PropertyMetadata("",
Sub(d As MyTextBox, e As DependencyPropertyChangedEventArgs)
d.SetValue(IsValidatedPropertyKey, String.IsNullOrEmpty(e.NewValue))
End Sub))
''' <summary>
''' 是否通过了输入验证。
''' </summary>
Public ReadOnly Property IsValidated As Boolean
Get
Return GetValue(IsValidatedProperty)
End Get
End Property
Private Shared ReadOnly IsValidatedPropertyKey As DependencyPropertyKey =
DependencyProperty.RegisterReadOnly("IsValidated", GetType(Boolean), GetType(MyTextBox), New PropertyMetadata(True))
Public Shared ReadOnly IsValidatedProperty As DependencyProperty = IsValidatedPropertyKey.DependencyProperty
''' <summary> ''' <summary>
''' 输入验证的规则。 ''' 输入验证的规则。
''' </summary> ''' </summary>
@@ -81,50 +108,49 @@
''' </summary> ''' </summary>
Public Sub Validate() Handles Me.Loaded Public Sub Validate() Handles Me.Loaded
'执行输入验证 '执行输入验证
ValidateResult = "" ValidateResult = ModValidate.Validate(Text, ValidateRules)
For Each ValidateRule As Validate In ValidateRules
ValidateResult = ValidateRule.Validate(Text)
If IsNothing(ValidateResult) OrElse Not ValidateResult = "" Then Exit For
Next
Dim IsSuccessful As Boolean = ValidateResult = ""
'根据结果改变样式 '根据结果改变样式
If ShownValidateResult <> If(IsSuccessful, ValidateState.Success, ValidateState.FailedAndShowDetail) Then If ShownValidateResult <> If(IsValidated, ValidateState.Success, ValidateState.FailedAndShowDetail) Then
If IsLoaded AndAlso labWrong IsNot Nothing Then If IsLoaded AndAlso labWrong IsNot Nothing Then
ChangeValidateResult(IsSuccessful, True) ChangeValidateResult(IsValidated, True)
Else Else
RunInNewThread(Sub() RunInNewThread(
Thread.Sleep(30) Sub()
RunInUi(Sub() ChangeValidateResult(IsSuccessful, False)) Thread.Sleep(30)
End Sub, "DelayedValidate Change") RunInUi(Sub() ChangeValidateResult(IsValidated, False))
End Sub, "DelayedValidate Change")
End If End If
End If End If
'更新错误信息 '更新错误信息
If ShowValidateResult AndAlso Not ValidateResult = "" Then If ShowValidateResult AndAlso Not IsValidated Then
If IsLoaded AndAlso labWrong IsNot Nothing Then If IsLoaded AndAlso labWrong IsNot Nothing Then
labWrong.Text = ValidateResult labWrong.Text = ValidateResult
Else Else
RunInNewThread(Sub() RunInNewThread(
Dim IsFinished As Boolean = False Sub()
Do Until IsFinished Dim IsFinished As Boolean = False
Thread.Sleep(20) Do Until IsFinished
RunInUiWait(Sub() Thread.Sleep(20)
If labWrong IsNot Nothing Then RunInUiWait(
labWrong.Text = ValidateResult Sub()
IsFinished = True If labWrong IsNot Nothing Then
End If labWrong.Text = ValidateResult
If Not IsLoaded Then IsFinished = True IsFinished = True
End Sub) End If
Loop If Not IsLoaded Then IsFinished = True
End Sub, "DelayedValidate Text") End Sub)
Loop
End Sub, "DelayedValidate Text")
End If End If
End If End If
End Sub End Sub
''' <summary> ''' <summary>
''' 强制显示结果为正常,类似尚未输入过文本的状态。不影响实际的检查结果。 ''' 强制显示结果为正常,类似尚未输入过文本的状态。不影响实际的检查结果。
''' </summary> ''' </summary>
Public Sub ForceShowAsSuccess() Public Sub ForceShowAsSuccess()
IsTextChanged = False IsTextChanged = False
ChangeValidateResult(ValidateResult = "", True) ChangeValidateResult(IsValidated, True)
End Sub End Sub
Private ShownValidateResult As ValidateState = ValidateState.NotInited Private ShownValidateResult As ValidateState = ValidateState.NotInited
Private Sub ChangeValidateResult(IsSuccessful As Boolean, IsLoaded As Boolean) Private Sub ChangeValidateResult(IsSuccessful As Boolean, IsLoaded As Boolean)
@@ -133,18 +159,18 @@
'变为正确 '变为正确
ShownValidateResult = If(IsSuccessful, ValidateState.Success, ValidateState.FailedButTextNotChanged) ShownValidateResult = If(IsSuccessful, ValidateState.Success, ValidateState.FailedButTextNotChanged)
AniStart({ AniStart({
AaOpacity(labWrong, -labWrong.Opacity, 150), AaOpacity(labWrong, -labWrong.Opacity, 150),
AaHeight(labWrong, -labWrong.Height, 150,, New AniEaseOutFluent), AaHeight(labWrong, -labWrong.Height, 150,, New AniEaseOutFluent),
AaCode(Sub() labWrong.Visibility = Visibility.Collapsed,, True) AaCode(Sub() labWrong.Visibility = Visibility.Collapsed,, True)
}, "MyTextBox Validate " & Uuid) }, "MyTextBox Validate " & Uuid)
ElseIf ShowValidateResult Then ElseIf ShowValidateResult Then
'变为错误 '变为错误
ShownValidateResult = ValidateState.FailedAndShowDetail ShownValidateResult = ValidateState.FailedAndShowDetail
labWrong.Visibility = Visibility.Visible labWrong.Visibility = Visibility.Visible
AniStart({ AniStart({
AaOpacity(labWrong, 1 - labWrong.Opacity, 170), AaOpacity(labWrong, 1 - labWrong.Opacity, 150),
AaHeight(labWrong, 21 - labWrong.Height, 300,, New AniEaseOutBack(AniEasePower.Weak)) AaHeight(labWrong, 21 - labWrong.Height, 150,, New AniEaseOutFluent)
}, "MyTextBox Validate " & Uuid) }, "MyTextBox Validate " & Uuid)
Else Else
'变为错误,但不显示文本 '变为错误,但不显示文本
ShownValidateResult = ValidateState.FailedAndHideDetail ShownValidateResult = ValidateState.FailedAndHideDetail
@@ -170,16 +196,19 @@
''' 是否已经由用户输入过文本,若尚未输入过,则不显示输入检查的失败。 ''' 是否已经由用户输入过文本,若尚未输入过,则不显示输入检查的失败。
''' </summary> ''' </summary>
Private IsTextChanged As Boolean = False Private IsTextChanged As Boolean = False
Private _HintText As String = ""
Public Property HintText As String Public Property HintText As String
Get Get
Return _HintText Return GetValue(HintTextProperty)
End Get End Get
Set(value As String) Set(value As String)
_HintText = value SetValue(HintTextProperty, value)
If labHint IsNot Nothing Then labHint.Text = If(Text = "", HintText, "")
End Set End Set
End Property End Property
Public Shared ReadOnly HintTextProperty As DependencyProperty =
DependencyProperty.Register("HintText", GetType(String), GetType(MyTextBox), New PropertyMetadata("",
Sub(t As MyTextBox, e As DependencyPropertyChangedEventArgs)
If t.labHint IsNot Nothing Then t.labHint.Text = If(t.Text = "", t.HintText, "")
End Sub))
Private Sub MyTextBox_TextChanged(sender As MyTextBox, e As TextChangedEventArgs) Handles Me.TextChanged Private Sub MyTextBox_TextChanged(sender As MyTextBox, e As TextChangedEventArgs) Handles Me.TextChanged
Try Try
'改变提示文本 '改变提示文本
@@ -188,7 +217,7 @@
IsTextChanged = IsLoaded IsTextChanged = IsLoaded
'进行输入验证 '进行输入验证
Validate() Validate()
If Not ValidateResult = "" Then Exit Sub If Not IsValidated Then Exit Sub
'改变文本 '改变文本
RaiseEvent ValidatedTextChanged(sender, e) RaiseEvent ValidatedTextChanged(sender, e)
Catch ex As Exception Catch ex As Exception
@@ -200,15 +229,13 @@
Private Sub RefreshColor() Handles Me.IsEnabledChanged, Me.MouseEnter, Me.MouseLeave, Me.GotFocus, Me.LostFocus Private Sub RefreshColor() Handles Me.IsEnabledChanged, Me.MouseEnter, Me.MouseLeave, Me.GotFocus, Me.LostFocus
Try Try
'手动关闭动画
If Not HasAnimation Then Exit Sub
'不对 ComboBox 从属进行动画 '不对 ComboBox 从属进行动画
If TemplatedParent IsNot Nothing AndAlso TypeOf TemplatedParent Is MyComboBox Then Exit Sub If TemplatedParent IsNot Nothing AndAlso TypeOf TemplatedParent Is MyComboBox Then Exit Sub
'判断当前颜色 '判断当前颜色
Dim ForeColorName As String, BackColorName As String Dim ForeColorName As String, BackColorName As String
Dim AnimationTime As Integer Dim AnimationTime As Integer
If IsEnabled Then If IsEnabled Then
If ValidateResult = "" OrElse Not IsTextChanged Then If IsValidated OrElse Not IsTextChanged Then
If IsFocused Then If IsFocused Then
ForeColorName = "ColorBrush3" ForeColorName = "ColorBrush3"
BackColorName = "ColorBrush7" BackColorName = "ColorBrush7"
@@ -232,6 +259,7 @@
BackColorName = "ColorBrushGray6" BackColorName = "ColorBrushGray6"
AnimationTime = 200 AnimationTime = 200
End If End If
If Not HasBackground Then BackColorName = "ColorBrushTransparent"
'触发颜色动画 '触发颜色动画
If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画 If IsLoaded AndAlso AniControlEnabled = 0 Then '防止默认属性变更触发动画
'有动画 '有动画
@@ -90,21 +90,21 @@
Get Get
Return GetValue(EventTypeProperty) Return GetValue(EventTypeProperty)
End Get End Get
Set(value As String) Set(value As String)
SetValue(EventTypeProperty, value) SetValue(EventTypeProperty, value)
End Set End Set
End Property End Property
Public Shared ReadOnly EventTypeProperty As DependencyProperty = DependencyProperty.Register("EventType", GetType(String), GetType(MyTextButton), New PropertyMetadata(Nothing)) Public Shared ReadOnly EventTypeProperty As DependencyProperty = DependencyProperty.Register(
"EventType", GetType(String), GetType(MyTextButton), New PropertyMetadata(Nothing))
Public Property EventData As String Public Property EventData As String
Get Get
Return GetValue(EventDataProperty) Return GetValue(EventDataProperty)
End Get End Get
Set(value As String) Set(value As String)
SetValue(EventDataProperty, value) SetValue(EventDataProperty, value)
End Set End Set
End Property End Property
Public Shared ReadOnly EventDataProperty As DependencyProperty = DependencyProperty.Register("EventData", GetType(String), GetType(MyTextButton), New PropertyMetadata(Nothing)) Public Shared ReadOnly EventDataProperty As DependencyProperty = DependencyProperty.Register(
"EventData", GetType(String), GetType(MyTextButton), New PropertyMetadata(Nothing))
End Class End Class
+4 -4
View File
@@ -104,7 +104,7 @@
<GradientStop Color="{StaticResource ColorObject3}" Offset="1"/> <GradientStop Color="{StaticResource ColorObject3}" Offset="1"/>
</LinearGradientBrush> </LinearGradientBrush>
</Grid.Background> </Grid.Background>
<Image x:Name="ImgTitle" IsHitTestVisible="False" Stretch="UniformToFill" IsEnabled="False" RenderOptions.BitmapScalingMode="LowQuality" /> <local:MyImage x:Name="ImgTitle" IsHitTestVisible="False" Stretch="UniformToFill" IsEnabled="False" RenderOptions.BitmapScalingMode="LowQuality" />
<local:MyIconButton x:Name="BtnTitleClose" HorizontalAlignment="Right" Height="28" VerticalAlignment="Center" Width="28" Margin="0,0,12,0" Theme="White" <local:MyIconButton x:Name="BtnTitleClose" HorizontalAlignment="Right" Height="28" VerticalAlignment="Center" Width="28" Margin="0,0,12,0" Theme="White"
LogoScale="0.72" Logo="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" /> LogoScale="0.72" Logo="F1 M2,0 L0,2 8,10 0,18 2,20 10,12 18,20 20,18 12,10 20,2 18,0 10,8 2,0Z" />
<local:MyIconButton x:Name="BtnTitleMin" HorizontalAlignment="Right" Height="28" VerticalAlignment="Center" Width="28" Margin="0,0,44,0" Theme="White" <local:MyIconButton x:Name="BtnTitleMin" HorizontalAlignment="Right" Height="28" VerticalAlignment="Center" Width="28" Margin="0,0,44,0" Theme="White"
@@ -117,7 +117,7 @@
</Grid.ColumnDefinitions> </Grid.ColumnDefinitions>
<Path x:Name="ShapeTitleLogo" Data="M26,29 v-25 h5 a7,7 180 0 1 0,14 h-5 M61,6.5 a10,11.5 180 1 0 0,18 M68,2.5 v24.5 h12 M98,2 v27 M107,2 v27" SnapsToDevicePixels="False" UseLayoutRounding="False" IsHitTestVisible="False" HorizontalAlignment="Left" Margin="19,15.5,0,15.5" Stretch="fill" Stroke="White" StrokeThickness="1.9" Width="53" /> <Path x:Name="ShapeTitleLogo" Data="M26,29 v-25 h5 a7,7 180 0 1 0,14 h-5 M61,6.5 a10,11.5 180 1 0 0,18 M68,2.5 v24.5 h12 M98,2 v27 M107,2 v27" SnapsToDevicePixels="False" UseLayoutRounding="False" IsHitTestVisible="False" HorizontalAlignment="Left" Margin="19,15.5,0,15.5" Stretch="fill" Stroke="White" StrokeThickness="1.9" Width="53" />
<TextBlock x:Name="LabTitleLogo" Visibility="Collapsed" SnapsToDevicePixels="False" UseLayoutRounding="False" IsHitTestVisible="False" HorizontalAlignment="Left" Margin="18,0,0,0" Foreground="White" FontSize="17" VerticalAlignment="Center" /> <TextBlock x:Name="LabTitleLogo" Visibility="Collapsed" SnapsToDevicePixels="False" UseLayoutRounding="False" IsHitTestVisible="False" HorizontalAlignment="Left" Margin="18,0,0,0" Foreground="White" FontSize="17" VerticalAlignment="Center" />
<Image x:Name="ImageTitleLogo" SnapsToDevicePixels="False" UseLayoutRounding="False" IsHitTestVisible="False" HorizontalAlignment="Left" Margin="7" VerticalAlignment="Center" Visibility="Collapsed" /> <local:MyImage x:Name="ImageTitleLogo" SnapsToDevicePixels="False" UseLayoutRounding="False" IsHitTestVisible="False" HorizontalAlignment="Left" Margin="7" VerticalAlignment="Center" Visibility="Collapsed" />
<StackPanel Grid.Column="1" x:Name="PanTitleSelect" HorizontalAlignment="Left" Height="27" VerticalAlignment="Center" Orientation="Horizontal" Margin="13,0"> <StackPanel Grid.Column="1" x:Name="PanTitleSelect" HorizontalAlignment="Left" Height="27" VerticalAlignment="Center" Orientation="Horizontal" Margin="13,0">
<local:MyRadioButton x:Name="BtnTitleSelect0" Text="{DynamicResource LangTitleHome}" Tag="0" Margin="5,0" Checked="True" Padding="2,0" <local:MyRadioButton x:Name="BtnTitleSelect0" Text="{DynamicResource LangTitleHome}" Tag="0" Margin="5,0" Checked="True" Padding="2,0"
LogoScale="0.95" Logo="M985.403 552.96C985.403 812.702 773.041 1024 512 1024S38.597 812.702 38.597 552.96c0-158.208 79.163-304.955 211.771-392.625 31.074-20.52 72.94-11.973 93.46 19.101s12.012 72.94-19.062 93.46c-94.681 62.622-151.237 167.306-151.237 280.064 0 185.344 151.788 336.108 338.471 336.108S850.471 738.304 850.471 552.96c0-114.649-57.974-220.278-155.096-282.585-31.35-20.125-40.448-61.833-20.362-93.184s61.794-40.448 93.184-20.4c135.995 87.236 217.206 235.362 217.206 396.169zM512 560.128c37.258 0 67.466-30.208 67.466-67.466V67.466C579.466 30.208 549.258 0 512 0s-67.466 30.208-67.466 67.466v425.196c0 37.258 30.208 67.466 67.466 67.466z" /> LogoScale="0.95" Logo="M985.403 552.96C985.403 812.702 773.041 1024 512 1024S38.597 812.702 38.597 552.96c0-158.208 79.163-304.955 211.771-392.625 31.074-20.52 72.94-11.973 93.46 19.101s12.012 72.94-19.062 93.46c-94.681 62.622-151.237 167.306-151.237 280.064 0 185.344 151.788 336.108 338.471 336.108S850.471 738.304 850.471 552.96c0-114.649-57.974-220.278-155.096-282.585-31.35-20.125-40.448-61.833-20.362-93.184s61.794-40.448 93.184-20.4c135.995 87.236 217.206 235.362 217.206 396.169zM512 560.128c37.258 0 67.466-30.208 67.466-67.466V67.466C579.466 30.208 549.258 0 512 0s-67.466 30.208-67.466 67.466v425.196c0 37.258 30.208 67.466 67.466 67.466z" />
@@ -133,7 +133,7 @@
</Grid> </Grid>
<Grid x:Name="PanTitleInner" Visibility="Collapsed" Margin="-16,0,0,0" Opacity="0" HorizontalAlignment="Left" Width="{Binding ActualWidth, ElementName=PanTitle, Mode=OneWay}"> <Grid x:Name="PanTitleInner" Visibility="Collapsed" Margin="-16,0,0,0" Opacity="0" HorizontalAlignment="Left" Width="{Binding ActualWidth, ElementName=PanTitle, Mode=OneWay}">
<local:MyIconButton HorizontalAlignment="Left" Theme="White" x:Name="BtnTitleInner" Margin="12,0,0,0" Height="28" Width="28" <local:MyIconButton HorizontalAlignment="Left" Theme="White" x:Name="BtnTitleInner" Margin="12,0,0,0" Height="28" Width="28"
LogoScale="0.87" Logo="M1097.162313 584.707482 250.272424 584.707482 562.833701 896.95123C591.749274 925.859979 591.749274 972.659975 562.833701 1001.568724 533.91812 1030.477473 487.058315 1030.477473 458.142742 1001.568724L21.580946 565.451235C6.757449 550.631234-0.361728 531.131238 0.028357 511.679985L0.028357 511.631236 0.028357 511.582486C-0.361728 492.13124 6.757449 472.582488 21.580946 457.762487L458.142742 21.644997C487.058315-7.215002 533.91812-7.215002 562.833701 21.644997 591.749274 50.553746 591.749274 97.4025 562.833701 126.262499L250.272424 438.55499 1097.162313 438.55499C1137.585605 438.55499 1170.304578 471.266238 1170.304578 511.631236 1170.304578 551.947483 1137.585605 584.707482 1097.162313 584.707482L1097.162313 584.707482Z" /> LogoScale="0.87" Logo="M1097 584 250 584 562 896C591 925 591 972 562 1001 533 1030 487 1030 458 1001L21 565C6 550-0 531 0 511L0 511 0 511C-0 492 6 472 21 457L458 21C487-7 533-7 562 21 591 50 591 97 562 126L250 438 1097 438C1137 438 1170 471 1170 511 1170 551 1137 584 1097 584L1097 584Z" />
<TextBlock SnapsToDevicePixels="False" IsHitTestVisible="False" Name="LabTitleInner" VerticalAlignment="Center" Margin="47,1,60,0" HorizontalAlignment="Left" Foreground="{DynamicResource ColorBrush8}" FontSize="15" /> <TextBlock SnapsToDevicePixels="False" IsHitTestVisible="False" Name="LabTitleInner" VerticalAlignment="Center" Margin="47,1,60,0" HorizontalAlignment="Left" Foreground="{DynamicResource ColorBrush8}" FontSize="15" />
</Grid> </Grid>
</Grid> </Grid>
@@ -166,7 +166,7 @@
</Border> </Border>
</Border> </Border>
</Grid> </Grid>
<StackPanel x:Name="PanHint" IsHitTestVisible="False" UseLayoutRounding="True" SnapsToDevicePixels="True" HorizontalAlignment="Left" VerticalAlignment="Bottom" Margin="0,0,0,25" Grid.RowSpan="2" /> <StackPanel x:Name="PanHint" IsHitTestVisible="False" UseLayoutRounding="True" SnapsToDevicePixels="True" HorizontalAlignment="Left" VerticalAlignment="Bottom" Margin="0,0,0,20" Grid.RowSpan="2" />
<StackPanel HorizontalAlignment="Right" VerticalAlignment="Bottom" Grid.Row="1" Margin="15"> <StackPanel HorizontalAlignment="Right" VerticalAlignment="Bottom" Grid.Row="1" Margin="15">
<local:MyExtraButton x:Name="BtnExtraBack" HorizontalAlignment="Right" VerticalAlignment="Center" ToolTip="返回顶部" Visibility="Collapsed" <local:MyExtraButton x:Name="BtnExtraBack" HorizontalAlignment="Right" VerticalAlignment="Center" ToolTip="返回顶部" Visibility="Collapsed"
Logo="M858.496 188.9024 173.1072 188.9024c-30.2848 0-54.8352-24.5504-54.8352-54.8352L118.272 106.6496c0-30.2848 24.5504-54.8352 54.8352-54.8352l685.3888 0c30.2848 0 54.8352 24.5504 54.8352 54.8352l0 27.4176C913.3312 164.352 888.7808 188.9024 858.496 188.9024L858.496 188.9024zM150.6048 550.8608c0 0 300.0064-240.3584 303.0272-243.328 13.9776-13.5936 31.1808-21.8624 48.8192-24.7552 1.7152-0.3072 3.4304-0.5888 5.1456-0.768 2.7392-0.3072 5.4528-0.3584 8.192-0.3328 2.7392-0.0256 5.4272 0.0256 8.1664 0.3328 1.7408 0.1792 3.4304 0.4864 5.1456 0.768 17.664 2.8928 34.8672 11.1616 48.8192 24.7552 3.0464 2.944 303.0016 243.328 303.0016 243.328 32.384 31.5136 29.6192 63.9744-2.7392 95.5136-32.3328 31.5392-75.648 2.9696-108.0064-28.544l-185.8816-147.1232 0 485.8368c0 30.3104-24.5248 54.8608-54.8352 54.8608l-27.392 0c-30.2848 0-54.8352-24.5504-54.8352-54.8608L447.232 470.7072l-185.8304 147.0976c-32.3584 31.5392-75.6992 60.1344-108.032 28.5696C121.0368 614.8352 118.272 582.3744 150.6048 550.8608L150.6048 550.8608zM150.6048 550.8608" /> Logo="M858.496 188.9024 173.1072 188.9024c-30.2848 0-54.8352-24.5504-54.8352-54.8352L118.272 106.6496c0-30.2848 24.5504-54.8352 54.8352-54.8352l685.3888 0c30.2848 0 54.8352 24.5504 54.8352 54.8352l0 27.4176C913.3312 164.352 888.7808 188.9024 858.496 188.9024L858.496 188.9024zM150.6048 550.8608c0 0 300.0064-240.3584 303.0272-243.328 13.9776-13.5936 31.1808-21.8624 48.8192-24.7552 1.7152-0.3072 3.4304-0.5888 5.1456-0.768 2.7392-0.3072 5.4528-0.3584 8.192-0.3328 2.7392-0.0256 5.4272 0.0256 8.1664 0.3328 1.7408 0.1792 3.4304 0.4864 5.1456 0.768 17.664 2.8928 34.8672 11.1616 48.8192 24.7552 3.0464 2.944 303.0016 243.328 303.0016 243.328 32.384 31.5136 29.6192 63.9744-2.7392 95.5136-32.3328 31.5392-75.648 2.9696-108.0064-28.544l-185.8816-147.1232 0 485.8368c0 30.3104-24.5248 54.8608-54.8352 54.8608l-27.392 0c-30.2848 0-54.8352-24.5504-54.8352-54.8608L447.232 470.7072l-185.8304 147.0976c-32.3584 31.5392-75.6992 60.1344-108.032 28.5696C121.0368 614.8352 118.272 582.3744 150.6048 550.8608L150.6048 550.8608zM150.6048 550.8608" />
+266 -437
View File
@@ -10,123 +10,55 @@ Public Class FormMain
Dim FeatureList As New List(Of KeyValuePair(Of Integer, String)) Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
'统计更新日志条目 '统计更新日志条目
#If BETA Then #If BETA Then
If LastVersion < 336 Then 'Release 2.8.6 If LastVersion < 355 Then 'Release 2.9.3
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "下载 Mod 时会使用 MCIM 国内镜像源")) FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:Minecraft 会优先使用独立显卡运行"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "Mod 管理页面允许筛选可更新/启用/禁用的 Mod")) FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:简化下载新版本第二步的 UI"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "打开 PCL 时会自动安装同目录下的 modpack.zip")) FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:使用新的版本隔离策略"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "爱发电域名迁移至 afdian.com")) FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:添加了在全局启动设置与版本独立设置之间互相跳转的按钮"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复 1.20.1+ 离线登录使用正版皮肤时无法保存游戏的 Bug")) FeatureCount += 20
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复安装的 1.14~1.15 Forge+OptiFine 无法进入世界的 Bug")) BugCount += 28
FeatureCount += 19
BugCount += 24
End If End If
If LastVersion < 332 Then 'Release 2.8.3 If LastVersion < 352 Then 'Release 2.9.1
If LastVersion = 330 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复部分玩家无法启动 MC 的 Bug")) FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "新增:导出整合包功能"))
End If FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:支持在超长路径下安装、启动游戏"))
If LastVersion < 330 Then 'Release 2.8.2 FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:无法安装 1.21 OptiFine"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "NeoForge 兼容与自动安装")) FeatureCount += 23
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持编译、运行 PCL 开源代码"))
FeatureCount += 15
BugCount += 22
End If
If LastVersion < 326 Then 'Release 2.7.4
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "会自动隐藏明显不可用的自动安装选项"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化正版登录流程和 MC 性能"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复正版登录时弹出脚本错误提示的 Bug"))
FeatureCount += 17
BugCount += 19
End If
If LastVersion < 323 Then 'Release 2.7.3
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "添加 启动游戏前进行内存优化 设置"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化 MC 性能"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复安装 OptiFine 有概率失败的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复启动 Fabric 1.20.5+ 时无法正确选择 Java 的 Bug"))
FeatureCount += 22
BugCount += 21
End If
If LastVersion < 321 Then 'Release 2.7.1
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复启动部分整合包导致设置丢失的 Bug"))
BugCount += 1
End If
If LastVersion < 319 Then 'Release 2.7.0
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "支持更新 Mod"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持查看可更新的 Mod 的更新日志"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持滑动鼠标快速选中、取消选中多个 Mod"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法启动 MC 24w14a+ 的 Bug"))
FeatureCount += 10
BugCount += 10 BugCount += 10
End If End If
If LastVersion < 317 Then 'Release 2.6.15 If LastVersion < 349 Then 'Release 2.8.13
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法安装 Forge 的 Bug")) FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:网络环境不佳时,Mod、整合包页面的加载速度"))
FeatureCount += 2 FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:部分电脑无法打开程序"))
BugCount += 2 FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:可能无法识别、更新 Mod"))
End If
If LastVersion < 315 Then 'Release 2.6.14
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化 MC 下载,尝试解决各种导致 MC 下载失败的问题"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "由于 MCBBS 关站,移除其相关内容"))
FeatureCount += 17
BugCount += 16
End If
If LastVersion < 313 Then 'Release 2.6.13
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法启动 Forge 1.18.3+ 的 Bug"))
FeatureCount += 6 FeatureCount += 6
BugCount += 10 BugCount += 14
End If End If
If LastVersion < 311 Then 'Release 2.6.12 If LastVersion < 347 Then 'Release 2.8.12
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "Mod 管理页面将显示 Mod 的中文名、图标、标签等信息")) FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "新增:Mod 管理页面添加下载 Mod、安装 Mod 选项"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "从 Mod 管理页面查看 Mod 信息时会跳转到其下载详情页面")) FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "新增:Mod 详情页面支持按加载器、游戏版本进行分类和筛选"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "重新设计 Mod 管理页面的交互与样式")) FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "新增:支持安装同时包含 modpack 文件和启动器的懒人包"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装 Forge 1.18.3+ 的 Bug")) FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "优化:整合包导入流程"))
FeatureCount += 27 FeatureCount += 43
BugCount += 25
End If
If LastVersion < 308 Then 'Release 2.6.10
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "为版本独立设置添加忽略 Java 兼容性警告选项"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复开始或结束游戏时可能报错的 Bug"))
FeatureCount += 31
BugCount += 37 BugCount += 37
End If End If
If LastVersion < 302 Then 'Release 2.6.7 If LastVersion < 342 Then 'Release 2.8.9
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "再次修复网络条件差时可能无法下载 MC 的 Bug")) FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "新增:支持下载原版服务端"))
BugCount += 1 FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "新增:本地 Mod 的标题支持选择显示 Mod 原始文件名"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:搜索后启用/禁用 Mod 时出错"))
FeatureCount += 17
BugCount += 13
End If End If
If LastVersion < 300 Then 'Release 2.6.6 If LastVersion < 340 Then 'Release 2.8.8
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持选择多种预设的主页")) If LastVersion = 338 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:数个与新正版登录相关的严重 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "Mod 管理中允许多选 Mod 进行批量操作")) FeatureCount += 3
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化崩溃分析,添加多种崩溃情况的判断")) BugCount += 7
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化联网获取的主页的加载与缓存"))
FeatureCount += 40
BugCount += 34
End If End If
If LastVersion < 296 Then 'Release 2.6.3 If LastVersion < 338 Then 'Release 2.8.7
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "新增内存优化功能,可以将所有程序的物理内存占用降低约 1/3")) FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "优化:使用新的正版登录方式,以提高安全性"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "在选择 OptiFine 与 Fabric 后会自动选择 OptiFabric")) FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:安装整合包、检索 Mod 的稳定性"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化崩溃分析,添加多种崩溃情况的判断")) FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:无法加载部分 Mod 的图标"))
FeatureCount += 21 FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:在 Mod 管理页面删除 Mod 导致报错"))
BugCount += 30 FeatureCount += 11
End If BugCount += 21
If LastVersion < 293 Then 'Release 2.6.1
BugCount += 1
End If
If LastVersion < 292 Then 'Release 2.6.0
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持在多个正版账号间切换"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "在缺少 Java 时会自动下载所需的 Java"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "重新制作正版登录页面"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "彻底移除 Mojang 登录"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "添加 CurseForge / Modrinth 来源筛选"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "Mod / 整合包下载会单独列出筛选的版本"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "为下载管理和音乐播放按钮添加进度条"))
FeatureCount += 24
BugCount += 24
End If
If LastVersion < 286 Then 'Release 2.5.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "支持搜索、安装 Modrinth 的 Mod 与整合包"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "资源搜索页面支持翻页"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "在全局启动设置中添加了 启动前执行命令 选项"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "重做资源下载的资源项界面"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "在选择下载 Fabric 时会自动选择 Fabric API"))
FeatureCount += 35
BugCount += 36
End If End If
#Else #Else
'5: FEAT+ '5: FEAT+
@@ -134,194 +66,85 @@ Public Class FormMain
'3:BUG+ IMP* FEAT- '3:BUG+ IMP* FEAT-
'2:BUG* IMP- '2:BUG* IMP-
'1:BUG- '1:BUG-
If LastVersion < 335 Then 'Snapshot 2.8.6 If LastVersion < 354 Then 'Snapshot 2.9.3
BugCount += 2 If LastVersion = 352 Then
End If FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:低版本 MC 没有声音"))
If LastVersion < 334 Then 'Snapshot 2.8.5 FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:若不安装 Mod 加载器,则无法安装 OptiFine 1.14+"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "Mod 管理页面允许筛选可更新/启用/禁用的 Mod"))
If LastVersion = 333 Then
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装愚人节和预发布版本的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法导出错误报告的 Bug"))
End If End If
FeatureCount += 6 FeatureCount += 8
BugCount += 7
End If
If LastVersion < 333 Then 'Snapshot 2.8.4
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "下载 Mod 时会使用 MCIM 国内镜像源"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "打开 PCL 时会自动安装同目录下的 modpack.zip"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "爱发电域名迁移至 afdian.com"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复 1.20.1+ 离线登录使用正版皮肤时无法保存游戏的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复安装的 1.14~1.15 Forge+OptiFine 无法进入世界的 Bug"))
FeatureCount += 13
BugCount += 17
End If
If LastVersion < 331 Then 'Snapshot 2.8.3
If LastVersion = 329 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复部分玩家无法启动 MC 的 Bug"))
End If
If LastVersion < 329 Then 'Snapshot 2.8.2
If LastVersion >= 327 Then
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装 Beta 版 NeoForge 的整合包的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复自动安装无法选择部分 OptiFine 的 Bug"))
End If
FeatureCount += 4
BugCount += 8 BugCount += 8
End If End If
If LastVersion < 328 Then 'Snapshot 2.8.1 If LastVersion < 353 Then 'Snapshot 2.9.2
If LastVersion = 327 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装 Forge 1.12.2- 的 Bug")) FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:Minecraft 会优先使用独立显卡运行"))
If LastVersion = 327 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法输入解锁码的 Bug")) FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化:简化下载新版本第二步的 UI"))
If LastVersion = 327 Then BugCount += 1 FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:使用新的版本隔离策略"))
End If FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:添加了在全局启动设置与版本独立设置之间互相跳转的按钮"))
If LastVersion < 327 Then 'Snapshot 2.8.0 FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:使用快照版导出带 PCL 的整合包可能失败"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "NeoForge 兼容与自动安装"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持编译、运行 PCL 开源代码"))
FeatureCount += 11
BugCount += 14
End If
If LastVersion < 325 Then 'Snapshot 2.7.4
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "会自动隐藏明显不可用的自动安装选项"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化正版登录流程和 MC 性能"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复正版登录时弹出脚本错误提示的 Bug"))
FeatureCount += 17
BugCount += 19
End If
If LastVersion < 324 Then 'Snapshot 2.7.3
FeatureCount += 4
BugCount += 3
End If
If LastVersion < 322 Then 'Snapshot 2.7.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "添加 启动游戏前进行内存优化 设置"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复安装 OptiFine 有概率失败的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复启动 Fabric 1.20.5+ 时无法正确选择 Java 的 Bug"))
FeatureCount += 18
BugCount += 18
End If
If LastVersion < 320 Then 'Snapshot 2.7.1
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复启动部分整合包导致设置丢失的 Bug"))
BugCount += 1
End If
If LastVersion < 318 Then 'Snapshot 2.7.0
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "支持更新 Mod"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持查看可更新的 Mod 的更新日志"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持滑动鼠标快速选中、取消选中多个 Mod"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法启动 MC 24w14a+ 的 Bug"))
FeatureCount += 10
BugCount += 10
End If
If LastVersion < 316 Then 'Snapshot 2.6.15
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "修复无法安装 Forge 的 Bug"))
FeatureCount += 2
BugCount += 2
End If
If LastVersion < 314 Then 'Snapshot 2.6.14
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "优化 MC 下载,尝试解决各种导致 MC 下载失败的问题"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "由于 MCBBS 关站,移除其相关内容"))
FeatureCount += 17
BugCount += 16
End If
If LastVersion < 312 Then 'Snapshot 2.6.13
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法启动 Forge 1.18.3+ 的 Bug"))
FeatureCount += 6
BugCount += 10
End If
If LastVersion < 310 Then 'Snapshot 2.6.12
If LastVersion = 309 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "Mod 管理页面添加启用、禁用单个 Mod 的快捷按钮"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装 Forge 1.18.3+ 的 Bug"))
FeatureCount += 13
BugCount += 12
End If
If LastVersion < 309 Then 'Snapshot 2.6.11
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "Mod 管理页面将显示 Mod 的中文名、图标、标签等信息"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "从 Mod 管理页面查看 Mod 信息时会跳转到其下载详情页面"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "重新设计 Mod 管理页面的交互与样式"))
FeatureCount += 15
BugCount += 13
End If
If LastVersion < 307 Then 'Snapshot 2.6.10
FeatureCount += 2
BugCount += 3
End If
If LastVersion < 306 Then 'Snapshot 2.6.9
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "为版本独立设置添加忽略 Java 兼容性警告选项"))
FeatureCount += 9
BugCount += 11
End If
If LastVersion < 305 Then 'Snapshot 2.6.8
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复开始或结束游戏时可能报错的 Bug"))
FeatureCount += 20
BugCount += 25
End If
If LastVersion < 303 Then 'Snapshot 2.6.7
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "再次修复网络条件差时可能无法下载 MC 的 Bug"))
BugCount += 1
End If
If LastVersion < 301 Then 'Snapshot 2.6.6
FeatureCount += 4
BugCount += 2
End If
If LastVersion < 299 Then 'Snapshot 2.6.5
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持选择多种预设的主页"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化联网获取的主页的加载与缓存"))
FeatureCount += 18
BugCount += 13
End If
If LastVersion < 298 Then 'Snapshot 2.6.4
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "Mod 管理中允许多选 Mod 进行批量操作"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化崩溃分析,添加多种崩溃情况的判断"))
FeatureCount += 18
BugCount += 19
End If
If LastVersion < 297 Then 'Snapshot 2.6.3
FeatureCount += 12 FeatureCount += 12
BugCount += 14 BugCount += 20
End If End If
If LastVersion < 294 Then 'Snapshot 2.6.2 If LastVersion < 351 Then 'Snapshot 2.9.1
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "新增内存优化功能,可以将所有程序的物理内存占用降低约 1/3")) If LastVersion = 350 Then
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "在选择 OptiFine 与 Fabric 后会自动选择 OptiFabric")) FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "优化:对导出整合包功能进行了 7 项优化,详见完整更新日志"))
FeatureCount += 9 FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:无法进行第三方登录"))
BugCount += 16 FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:在部分版本下,打开导出页面会导致启动器崩溃"))
End If BugCount += 1
If LastVersion < 291 Then 'Snapshot 2.6.0 End If
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "支持在多个正版账号间切换"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "Mod / 整合包下载会单独列出筛选的版本"))
FeatureCount += 10
BugCount += 2 BugCount += 2
End If End If
If LastVersion < 289 Then 'Snapshot 2.5.4 If LastVersion < 350 Then 'Snapshot 2.9.0
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "重新制作正版登录页面")) FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "新增:导出整合包功能"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "彻底移除 Mojang 登录")) FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:支持在超长路径下安装、启动游戏"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:无法安装 1.21 OptiFine"))
FeatureCount += 21
BugCount += 10
End If
If LastVersion < 348 Then 'Snapshot 2.8.13
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:网络环境不佳时,Mod、整合包页面的加载速度"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:部分电脑无法打开程序"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:可能无法识别、更新 Mod"))
FeatureCount += 6 FeatureCount += 6
BugCount += 14 BugCount += 14
End If End If
If LastVersion < 288 Then 'Snapshot 2.5.3 If LastVersion < 346 Then 'Snapshot 2.8.12
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "在缺少 Java 时会自动下载所需的 Java")) If LastVersion = 345 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:帮助页面报错"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "添加 CurseForge / Modrinth 来源筛选"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "为下载管理和音乐播放按钮添加进度条"))
FeatureCount += 8
BugCount += 8
End If End If
If LastVersion < 285 Then 'Snapshot 2.5.2 If LastVersion < 345 Then 'Snapshot 2.8.11
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "重做资源下载的资源项界面")) FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "新增:Mod 管理页面添加下载 Mod、安装 Mod 选项"))
If LastVersion = 284 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复打开部分帮助报错的 Bug")) FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "新增:Mod 详情页面支持按加载器、游戏版本进行分类和筛选"))
FeatureCount += 8 FeatureCount += 23
BugCount += 8
End If
If LastVersion < 284 Then 'Snapshot 2.5.1
If LastVersion >= 275 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "在全局启动设置中添加了 启动前执行命令 选项"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "在选择下载 Fabric 时会自动选择 Fabric API"))
FeatureCount += 22
BugCount += 21 BugCount += 21
End If End If
If LastVersion < 283 Then 'Snapshot 2.5.0 If LastVersion < 343 Then 'Snapshot 2.8.10
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "支持搜索、下载 Modrinth 中的 Mod 与整合包")) FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "新增:支持安装同时包含 modpack 文件和启动器的懒人包"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "资源搜索页面支持翻页")) FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "优化:整合包导入流程"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持安装 Modrinth 整合包")) FeatureCount += 20
FeatureCount += 5 BugCount += 16
BugCount += 5 End If
If LastVersion < 341 Then 'Snapshot 2.8.9
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "新增:支持下载原版服务端"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "新增:本地 Mod 的标题支持选择显示 Mod 原始文件名"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:搜索后启用/禁用 Mod 时出错"))
FeatureCount += 17
BugCount += 13
End If
If LastVersion < 339 Then 'Snapshot 2.8.8
If LastVersion = 337 Then FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:数个与新正版登录相关的严重 Bug"))
FeatureCount += 3
BugCount += 7
End If
If LastVersion < 337 Then 'Snapshot 2.8.7
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "优化:使用新的正版登录方式,以提高安全性"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化:安装整合包、检索 Mod 的稳定性"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:无法加载部分 Mod 的图标"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复:在 Mod 管理页面删除 Mod 导致报错"))
FeatureCount += 11
BugCount += 21
End If End If
#End If #End If
'整理更新日志文本 '整理更新日志文本
Dim ContentList As New List(Of String) Dim ContentList As New List(Of String)
Dim SortedFeatures = Sort(FeatureList, Function(Left, Right) Left.Key > Right.Key) Dim SortedFeatures = FeatureList.OrderByDescending(Function(f) f.Key).ToList
If Not SortedFeatures.Any() AndAlso FeatureCount = 0 AndAlso BugCount = 0 Then ContentList.Add("龙猫忘记写更新日志啦!可以去提醒他一下……") If Not SortedFeatures.Any() AndAlso FeatureCount = 0 AndAlso BugCount = 0 Then ContentList.Add("龙猫忘记写更新日志啦!可以去提醒他一下……")
For i = 0 To Math.Min(9, SortedFeatures.Count - 1) '最多取 10 项 For i = 0 To Math.Min(9, SortedFeatures.Count - 1) '最多取 10 项
ContentList.Add(SortedFeatures(i).Value) ContentList.Add(SortedFeatures(i).Value)
@@ -360,9 +183,19 @@ Public Class FormMain
'触发降级 '触发降级
DowngradeSub(LastVersion) DowngradeSub(LastVersion)
End If End If
''刷新语言 '版本隔离设置迁移
'Lang = ReadReg("Lang", "zh_CN") If Setup.IsUnset("LaunchArgumentIndieV2") Then
'Application.Current.Resources.MergedDictionaries(1) = New ResourceDictionary With {.Source = New Uri("Resources\Language\" & Lang & ".xaml", UriKind.Relative)} If Not Setup.IsUnset("LaunchArgumentIndie") Then
Log("[Start] 从老 PCL 迁移版本隔离")
Setup.Set("LaunchArgumentIndieV2", Setup.Get("LaunchArgumentIndie"))
ElseIf Not Setup.IsUnset("WindowHeight") Then
Log("[Start] 从老 PCL 升级,但此前未调整版本隔离,使用老的版本隔离默认值")
Setup.Set("LaunchArgumentIndieV2", Setup.GetDefault("LaunchArgumentIndie"))
Else
Log("[Start] 全新的 PCL,使用新的版本隔离默认值")
Setup.Set("LaunchArgumentIndieV2", Setup.GetDefault("LaunchArgumentIndieV2"))
End If
End If
'刷新主题 '刷新主题
ThemeCheckAll(False) ThemeCheckAll(False)
Setup.Load("UiLauncherTheme") Setup.Load("UiLauncherTheme")
@@ -380,7 +213,9 @@ Public Class FormMain
If Not IsNothing(FrmLaunchLeft.Parent) Then FrmLaunchLeft.SetValue(ContentPresenter.ContentProperty, Nothing) If Not IsNothing(FrmLaunchLeft.Parent) Then FrmLaunchLeft.SetValue(ContentPresenter.ContentProperty, Nothing)
If Not IsNothing(FrmLaunchRight.Parent) Then FrmLaunchRight.SetValue(ContentPresenter.ContentProperty, Nothing) If Not IsNothing(FrmLaunchRight.Parent) Then FrmLaunchRight.SetValue(ContentPresenter.ContentProperty, Nothing)
PanMainLeft.Child = FrmLaunchLeft PanMainLeft.Child = FrmLaunchLeft
PageLeft = FrmLaunchLeft
PanMainRight.Child = FrmLaunchRight PanMainRight.Child = FrmLaunchRight
PageRight = FrmLaunchRight
FrmLaunchRight.PageState = MyPageRight.PageStates.ContentStay FrmLaunchRight.PageState = MyPageRight.PageStates.ContentStay
'模式提醒 '模式提醒
#If DEBUG Then #If DEBUG Then
@@ -425,13 +260,17 @@ Public Class FormMain
'加载窗口 '加载窗口
ThemeRefreshMain() ThemeRefreshMain()
Try Try
Height = ReadReg("WindowHeight", MinHeight + 50) Height = Setup.Get("WindowHeight")
Width = ReadReg("WindowWidth", MinWidth + 50) Width = Setup.Get("WindowWidth")
Catch ex As Exception '修复 #2019 Catch ex As Exception '修复 #2019
Log(ex, "读取窗口默认大小失败", LogLevel.Hint) Log(ex, "读取窗口默认大小失败", LogLevel.Hint)
Height = MinHeight + 50 Height = MinHeight + 100
Width = MinWidth + 50 Width = MinWidth + 100
End Try End Try
'#If DEBUG Then
' MinHeight = 50
' MinWidth = 50
'#End If
Topmost = False Topmost = False
If FrmStart IsNot Nothing Then FrmStart.Close(New TimeSpan(0, 0, 0, 0, 400 / AniSpeed)) If FrmStart IsNot Nothing Then FrmStart.Close(New TimeSpan(0, 0, 0, 0, 400 / AniSpeed))
'更改窗口 '更改窗口
@@ -462,7 +301,7 @@ Public Class FormMain
'EULA 提示 'EULA 提示
If Not Setup.Get("SystemEula") Then If Not Setup.Get("SystemEula") Then
Select Case MyMsgBox("在使用 PCL 前,请同意 PCL 的用户协议与免责声明。", "协议授权", "同意", "拒绝", "查看用户协议与免责声明", Select Case MyMsgBox("在使用 PCL 前,请同意 PCL 的用户协议与免责声明。", "协议授权", "同意", "拒绝", "查看用户协议与免责声明",
Button3Action:=Sub() OpenWebsite("https://shimo.im/docs/rGrd8pY8xWkt6ryW")) Button3Action:=Sub() OpenWebsite("https://shimo.im/docs/rGrd8pY8xWkt6ryW"))
Case 1 Case 1
Setup.Set("SystemEula", True) Setup.Set("SystemEula", True)
Case 2 Case 2
@@ -476,6 +315,7 @@ Public Class FormMain
DlClientListMojangLoader.Start(1) DlClientListMojangLoader.Start(1)
RunCountSub() RunCountSub()
ServerLoader.Start(1) ServerLoader.Start(1)
RunInNewThread(AddressOf TryClearTaskTemp, "TryClearTaskTemp", ThreadPriority.BelowNormal)
Catch ex As Exception Catch ex As Exception
Log(ex, "初始化加载池运行失败", LogLevel.Feedback) Log(ex, "初始化加载池运行失败", LogLevel.Feedback)
End Try End Try
@@ -565,8 +405,23 @@ Public Class FormMain
Setup.Set("UiHiddenOtherHelp", False) Setup.Set("UiHiddenOtherHelp", False)
Log("[Start] 已解除帮助页面的隐藏") Log("[Start] 已解除帮助页面的隐藏")
End If End If
'单向迁移微软登录结果(#4836)
If Not Setup.Get("CacheMsV2Migrated") Then
Setup.Set("CacheMsV2Migrated", True)
Setup.Set("CacheMsV2OAuthRefresh", Setup.Get("CacheMsOAuthRefresh"))
Setup.Set("CacheMsV2Access", Setup.Get("CacheMsAccess"))
Setup.Set("CacheMsV2ProfileJson", Setup.Get("CacheMsProfileJson"))
Setup.Set("CacheMsV2Uuid", Setup.Get("CacheMsUuid"))
Setup.Set("CacheMsV2Name", Setup.Get("CacheMsName"))
Log("[Start] 已从老版本迁移微软登录结果")
End If
'Mod 命名设置迁移
If Not Setup.IsUnset("ToolDownloadTranslate") AndAlso Setup.IsUnset("ToolDownloadTranslateV2") Then
Setup.Set("ToolDownloadTranslateV2", Setup.Get("ToolDownloadTranslate") + 1)
Log("[Start] 已从老版本迁移 Mod 命名设置")
End If
'输出更新日志 '输出更新日志
If LastVersionCode = 0 Then Exit Sub If LastVersionCode <= 0 Then Exit Sub
If LowerVersionCode >= VersionCode Then Exit Sub If LowerVersionCode >= VersionCode Then Exit Sub
ShowUpdateLog(LowerVersionCode) ShowUpdateLog(LowerVersionCode)
End Sub End Sub
@@ -606,45 +461,45 @@ Public Class FormMain
End If End If
'关闭 '关闭
RunInUiWait( RunInUiWait(
Sub() Sub()
IsHitTestVisible = False IsHitTestVisible = False
If PanBack.RenderTransform Is Nothing Then If PanBack.RenderTransform Is Nothing Then
Dim TransformPos As New TranslateTransform(0, 0) Dim TransformPos As New TranslateTransform(0, 0)
Dim TransformRotate As New RotateTransform(0) Dim TransformRotate As New RotateTransform(0)
Dim TransformScale As New ScaleTransform(1, 1) Dim TransformScale As New ScaleTransform(1, 1)
PanBack.RenderTransform = New TransformGroup() With {.Children = New TransformCollection({TransformRotate, TransformPos, TransformScale})} PanBack.RenderTransform = New TransformGroup() With {.Children = New TransformCollection({TransformRotate, TransformPos, TransformScale})}
AniStart({ AniStart({
AaOpacity(Me, -Opacity, 140, 40, New AniEaseOutFluent(AniEasePower.Weak)), AaOpacity(Me, -Opacity, 140, 40, New AniEaseOutFluent(AniEasePower.Weak)),
AaDouble( AaDouble(
Sub(i) Sub(i)
TransformScale.ScaleX += i TransformScale.ScaleX += i
TransformScale.ScaleY += i TransformScale.ScaleY += i
End Sub, 0.88 - TransformScale.ScaleX, 180), End Sub, 0.88 - TransformScale.ScaleX, 180),
AaDouble(Sub(i) TransformPos.Y += i, 20 - TransformPos.Y, 180, 0, New AniEaseOutFluent(AniEasePower.Weak)), AaDouble(Sub(i) TransformPos.Y += i, 20 - TransformPos.Y, 180, 0, New AniEaseOutFluent(AniEasePower.Weak)),
AaDouble(Sub(i) TransformRotate.Angle += i, 0.6 - TransformRotate.Angle, 180, 0, New AniEaseInoutFluent(AniEasePower.Weak)), AaDouble(Sub(i) TransformRotate.Angle += i, 0.6 - TransformRotate.Angle, 180, 0, New AniEaseInoutFluent(AniEasePower.Weak)),
AaCode( AaCode(
Sub() Sub()
IsHitTestVisible = False IsHitTestVisible = False
Top = -10000 Top = -10000
ShowInTaskbar = False ShowInTaskbar = False
End Sub, 210), End Sub, 210),
AaCode(AddressOf EndProgramForce, 230) AaCode(AddressOf EndProgramForce, 230)
}, "Form Close") }, "Form Close")
Else Else
EndProgramForce() EndProgramForce()
End If End If
Log("[System] 收到关闭指令") Log("[System] 收到关闭指令")
End Sub) End Sub)
End Sub End Sub
Private Shared IsLogShown As Boolean = False Private Shared IsLogShown As Boolean = False
Public Shared Sub EndProgramForce(Optional ReturnCode As Result = Result.Success) Public Shared Sub EndProgramForce(Optional ReturnCode As ProcessReturnValues = ProcessReturnValues.Success)
On Error Resume Next On Error Resume Next
IsProgramEnded = True IsProgramEnded = True
AniControlEnabled += 1 AniControlEnabled += 1
PageLinkIoi.IoiStop(False) PageLinkIoi.IoiStop(False)
PageLinkHiper.HiperStop(False) PageLinkHiper.HiperStop(False)
If IsUpdateWaitingRestart Then UpdateRestart(False) If IsUpdateWaitingRestart Then UpdateRestart(False)
If ReturnCode = Result.Exception Then If ReturnCode = ProcessReturnValues.Exception Then
If Not IsLogShown Then If Not IsLogShown Then
FeedbackInfo() FeedbackInfo()
Log("请在 https://github.com/Hex-Dragon/PCL2/issues 提交错误报告,以便于作者解决此问题!") Log("请在 https://github.com/Hex-Dragon/PCL2/issues 提交错误报告,以便于作者解决此问题!")
@@ -655,7 +510,7 @@ Public Class FormMain
End If End If
Log("[System] 程序已退出,返回值:" & GetStringFromEnum(CType(ReturnCode, [Enum]))) Log("[System] 程序已退出,返回值:" & GetStringFromEnum(CType(ReturnCode, [Enum])))
LogFlush() LogFlush()
If ReturnCode = Result.Success Then If ReturnCode = ProcessReturnValues.Success Then
Process.GetCurrentProcess.Kill() Process.GetCurrentProcess.Kill()
Else Else
Environment.Exit(ReturnCode) Environment.Exit(ReturnCode)
@@ -679,8 +534,8 @@ Public Class FormMain
Public IsSizeSaveable As Boolean = False Public IsSizeSaveable As Boolean = False
Private Sub FormMain_SizeChanged() Handles Me.SizeChanged, Me.Loaded Private Sub FormMain_SizeChanged() Handles Me.SizeChanged, Me.Loaded
If IsSizeSaveable Then If IsSizeSaveable Then
WriteReg("WindowHeight", Height) Setup.Set("WindowHeight", Height)
WriteReg("WindowWidth", Width) Setup.Set("WindowWidth", Width)
End If End If
RectForm.Rect = New Rect(0, 0, BorderForm.ActualWidth, BorderForm.ActualHeight) RectForm.Rect = New Rect(0, 0, BorderForm.ActualWidth, BorderForm.ActualHeight)
PanForm.Width = BorderForm.ActualWidth + 0.001 PanForm.Width = BorderForm.ActualWidth + 0.001
@@ -709,7 +564,7 @@ Public Class FormMain
Exit Sub Exit Sub
ElseIf e.Key = Key.Escape Then ElseIf e.Key = Key.Escape Then
Dim Msg As Object = PanMsg.Children(0) Dim Msg As Object = PanMsg.Children(0)
If TypeOf Msg Is MyMsgText AndAlso Msg.Btn3.Visibility = Visibility.Visible Then If TypeOf Msg IsNot MyMsgInput AndAlso TypeOf Msg IsNot MyMsgSelect AndAlso Msg.Btn3.Visibility = Visibility.Visible Then
Msg.Btn3_Click() Msg.Btn3_Click()
ElseIf Msg.Btn2.Visibility = Visibility.Visible Then ElseIf Msg.Btn2.Visibility = Visibility.Visible Then
Msg.Btn2_Click() Msg.Btn2_Click()
@@ -738,6 +593,12 @@ Public Class FormMain
PageSetupUI.HiddenRefresh() PageSetupUI.HiddenRefresh()
Exit Sub Exit Sub
End If End If
'按 F5 刷新页面
If e.Key = Key.F5 Then
If TypeOf PageLeft Is IRefreshable Then CType(PageLeft, IRefreshable).Refresh()
If TypeOf PageRight Is IRefreshable Then CType(PageRight, IRefreshable).Refresh()
Exit Sub
End If
'调用启动游戏 '调用启动游戏
If e.Key = Key.Enter AndAlso PageCurrent = FormMain.PageType.Launch Then If e.Key = Key.Enter AndAlso PageCurrent = FormMain.PageType.Launch Then
If IsAprilEnabled AndAlso Not IsAprilGiveup Then If IsAprilEnabled AndAlso Not IsAprilGiveup Then
@@ -751,6 +612,7 @@ Public Class FormMain
End Sub End Sub
Private Sub FormMain_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseDown Private Sub FormMain_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseDown
'鼠标侧键返回上一级 '鼠标侧键返回上一级
If FrmMain.PanMsg.Children.Count > 0 OrElse WaitingMyMsgBox.Any Then Exit Sub '弹窗中(#5513)
If e.ChangedButton = MouseButton.XButton1 OrElse e.ChangedButton = MouseButton.XButton2 Then TriggerPageBack() If e.ChangedButton = MouseButton.XButton1 OrElse e.ChangedButton = MouseButton.XButton2 Then TriggerPageBack()
End Sub End Sub
Private Sub TriggerPageBack() Private Sub TriggerPageBack()
@@ -875,14 +737,14 @@ Public Class FormMain
If FilePathList.Count > 1 Then If FilePathList.Count > 1 Then
'必须要求全部为 jar 文件 '必须要求全部为 jar 文件
For Each File In FilePathList For Each File In FilePathList
If Not {"jar", "litemod", "disabled", "old"}.Contains(File.After(".").ToLower) Then If Not {"jar", "litemod", "disabled", "old"}.Contains(File.AfterLast(".").ToLower) Then
Hint("一次请只拖入一个文件!", HintType.Critical) Hint("一次请只拖入一个文件!", HintType.Critical)
Exit Sub Exit Sub
End If End If
Next Next
End If End If
'自定义主页 '自定义主页
Dim Extension As String = FilePath.After(".").ToLower Dim Extension As String = FilePath.AfterLast(".").ToLower
If Extension = "xaml" Then If Extension = "xaml" Then
Log("[System] 文件后缀为 XAML,作为自定义主页加载") Log("[System] 文件后缀为 XAML,作为自定义主页加载")
If File.Exists(Path & "PCL\Custom.xaml") Then If File.Exists(Path & "PCL\Custom.xaml") Then
@@ -891,53 +753,27 @@ Public Class FormMain
End If End If
End If End If
CopyFile(FilePath, Path & "PCL\Custom.xaml") CopyFile(FilePath, Path & "PCL\Custom.xaml")
RunInUi(Sub() RunInUi(
Setup.Set("UiCustomType", 1) Sub()
FrmLaunchRight.ForceRefresh() Setup.Set("UiCustomType", 1)
Hint("已加载主页自定义文件!", HintType.Finish) FrmLaunchRight.ForceRefresh()
End Sub) Hint("已加载主页自定义文件!", HintType.Finish)
Exit Sub End Sub)
End If
'Mod 安装
If {"jar", "litemod", "disabled", "old"}.Any(Function(t) t = Extension) Then
Log("[System] 文件为 jar/litemod 格式,尝试作为 Mod 安装")
'获取并检查目标版本
Dim TargetVersion As McVersion = McVersionCurrent
If PageCurrent = PageType.VersionSetup Then TargetVersion = PageVersionLeft.Version
If PageCurrent = PageType.VersionSelect OrElse TargetVersion Is Nothing OrElse Not TargetVersion.Modable Then
'正在选择版本,或当前版本不能安装 Mod
Hint("若要安装 Mod,请先选择一个可以安装 Mod 的版本!")
ElseIf Not (PageCurrent = PageType.VersionSetup AndAlso PageCurrentSub = PageSubType.VersionMod) Then
'未处于 Mod 管理页面
If MyMsgBox($"是否要将这{If(FilePathList.Count = 1, "个", "些")}文件作为 Mod 安装到 {TargetVersion.Name}?", "Mod 安装确认", "确定", "取消") = 1 Then GoTo Install
Else
'处于 Mod 管理页面
Install:
Try
For Each ModFile In FilePathList
Dim NewFileName = GetFileNameFromPath(ModFile).Replace(".disabled", "")
If Not NewFileName.Contains(".") Then NewFileName += ".jar" '#4227
CopyFile(ModFile, TargetVersion.PathIndie & "mods\" & NewFileName)
Next
If FilePathList.Count = 1 Then
Hint($"已安装 {GetFileNameFromPath(FilePathList.First).Replace(".disabled", "")}!", HintType.Finish)
Else
Hint($"已安装 {FilePathList.Count} 个 Mod!", HintType.Finish)
End If
'刷新列表
If PageCurrent = PageType.VersionSetup AndAlso PageCurrentSub = PageSubType.VersionMod Then
LoaderFolderRun(McModLoader, TargetVersion.PathIndie & "mods\", LoaderFolderRunType.ForceRun)
End If
Catch ex As Exception
Log(ex, "复制 Mod 文件失败", LogLevel.Msgbox)
End Try
End If
Exit Sub Exit Sub
End If End If
'安装 Mod
If PageVersionMod.InstallMods(FilePathList) Then Exit Sub
'安装整合包 '安装整合包
If {"zip", "rar", "mrpack"}.Any(Function(t) t = Extension) Then '部分压缩包是 zip 格式但后缀为 rar,总之试一试 If {"zip", "rar", "mrpack"}.Any(Function(t) t = Extension) Then '部分压缩包是 zip 格式但后缀为 rar,总之试一试
Log("[System] 文件为压缩包,尝试作为整合包安装") Log("[System] 文件为压缩包,尝试作为整合包安装")
If ModpackInstall(FilePath, ShowHint:=False) IsNot Nothing Then Exit Sub Try
ModpackInstall(FilePath)
Exit Sub
Catch ex As CancelledException
Exit Sub '用户主动取消
Catch ex As Exception
'安装失败,继续往后尝试
End Try
End If End If
'RAR 处理 'RAR 处理
If Extension = "rar" Then If Extension = "rar" Then
@@ -1011,18 +847,19 @@ Install:
''' 把当前窗口拖到最前面。 ''' 把当前窗口拖到最前面。
''' </summary> ''' </summary>
Public Sub ShowWindowToTop() Public Sub ShowWindowToTop()
RunInUi(Sub() RunInUi(
'这一坨乱七八糟的,别改,改了指不定就炸了,自己电脑还复现不出来 Sub()
Visibility = Visibility.Visible '这一坨乱七八糟的,别改,改了指不定就炸了,自己电脑还复现不出来
ShowInTaskbar = True Visibility = Visibility.Visible
WindowState = WindowState.Normal ShowInTaskbar = True
Hidden = False WindowState = WindowState.Normal
Topmost = True '偶尔 SetForegroundWindow 失效 Hidden = False
Topmost = False Topmost = True '偶尔 SetForegroundWindow 失效
SetForegroundWindow(Handle) Topmost = False
Focus() SetForegroundWindow(Handle)
Log("[System] 窗口已置顶,位置:(" & Left & ", " & Top & "), " & Width & " x " & Height) Focus()
End Sub) Log($"[System] 窗口已置顶,位置:({Left}, {Top}), {Width} x {Height}")
End Sub)
End Sub End Sub
#End Region #End Region
@@ -1090,6 +927,7 @@ Install:
DownloadLiteLoader = 9 DownloadLiteLoader = 9
DownloadMod = 11 DownloadMod = 11
DownloadPack = 12 DownloadPack = 12
DownloadResourcePack = 13
DownloadShader = 14 DownloadShader = 14
SetupLaunch = 0 SetupLaunch = 0
SetupUI = 1 SetupUI = 1
@@ -1107,6 +945,7 @@ Install:
VersionSetup = 1 VersionSetup = 1
VersionMod = 2 VersionMod = 2
VersionModDisabled = 3 VersionModDisabled = 3
VersionExport = 4
End Enum End Enum
''' <summary> ''' <summary>
''' 获取次级页面的名称。若并非次级页面则返回空字符串,故可以以此判断是否为次级页面。 ''' 获取次级页面的名称。若并非次级页面则返回空字符串,故可以以此判断是否为次级页面。
@@ -1169,9 +1008,6 @@ Install:
Case PageType.Download Case PageType.Download
If FrmDownloadLeft Is Nothing Then FrmDownloadLeft = New PageDownloadLeft If FrmDownloadLeft Is Nothing Then FrmDownloadLeft = New PageDownloadLeft
Return FrmDownloadLeft.PageID Return FrmDownloadLeft.PageID
Case PageType.Link
If FrmLinkLeft Is Nothing Then FrmLinkLeft = New PageLinkLeft
Return FrmLinkLeft.PageID
Case PageType.Setup Case PageType.Setup
If FrmSetupLeft Is Nothing Then FrmSetupLeft = New PageSetupLeft If FrmSetupLeft Is Nothing Then FrmSetupLeft = New PageSetupLeft
Return FrmSetupLeft.PageID Return FrmSetupLeft.PageID
@@ -1240,9 +1076,6 @@ Install:
CType(PanTitleSelect.Children(Stack), MyRadioButton).SetChecked(True, True, PageNameGet(PageCurrent) = "") CType(PanTitleSelect.Children(Stack), MyRadioButton).SetChecked(True, True, PageNameGet(PageCurrent) = "")
IsChangingPage = False IsChangingPage = False
Select Case Stack.Page Select Case Stack.Page
Case PageType.Link
If FrmLinkLeft Is Nothing Then FrmLinkLeft = New PageLinkLeft
CType(FrmLinkLeft.PanItem.Children(SubType), MyListItem).SetChecked(True, True, Stack = PageCurrent)
Case PageType.Download Case PageType.Download
If FrmDownloadLeft Is Nothing Then FrmDownloadLeft = New PageDownloadLeft If FrmDownloadLeft Is Nothing Then FrmDownloadLeft = New PageDownloadLeft
CType(FrmDownloadLeft.PanItem.Children(SubType), MyListItem).SetChecked(True, True, Stack = PageCurrent) CType(FrmDownloadLeft.PanItem.Children(SubType), MyListItem).SetChecked(True, True, Stack = PageCurrent)
@@ -1271,14 +1104,6 @@ Install:
If IsChangingPage Then Exit Sub If IsChangingPage Then Exit Sub
PageChangeActual(Val(sender.Tag)) PageChangeActual(Val(sender.Tag))
End Sub End Sub
Private Sub CancelLink(sender As Object, e As RouteEventArgs) Handles BtnTitleSelect2.PreviewClick
If MyMsgBox("由于联机提供商要求新联机强制付费,且高度商业化,PCL 将暂时关闭联机功能,不再使用该联机模块。" & vbCrLf &
"PCL、HMCL、BakaXL 将合作开发新的跨启动器联机功能,在开发结束后将同步开放,请各位多多理解。",
"联机功能已暂时关闭", "查看详情", "确定") = 1 Then
OpenWebsite("https://www.bilibili.com/read/cv19845645")
End If
e.Handled = True
End Sub
''' <summary> ''' <summary>
''' 通过点击返回按钮或手动触发返回来改变页面。 ''' 通过点击返回按钮或手动触发返回来改变页面。
''' </summary> ''' </summary>
@@ -1309,9 +1134,9 @@ Install:
If PageStack.Any Then If PageStack.Any Then
'子页面 → 另一个子页面,更新 '子页面 → 另一个子页面,更新
AniStart({ AniStart({
AaOpacity(LabTitleInner, -LabTitleInner.Opacity, 130), AaOpacity(LabTitleInner, -LabTitleInner.Opacity, 130),
AaCode(Sub() LabTitleInner.Text = PageName,, True), AaCode(Sub() LabTitleInner.Text = PageName,, True),
AaOpacity(LabTitleInner, 1, 150, 30) AaOpacity(LabTitleInner, 1, 150, 30)
}, "FrmMain Titlebar SubLayer") }, "FrmMain Titlebar SubLayer")
If PageStack.Contains(Stack) Then If PageStack.Contains(Stack) Then
'返回到更上层的子页面 '返回到更上层的子页面
@@ -1405,37 +1230,41 @@ Install:
AniControlEnabled -= 1 AniControlEnabled -= 1
'执行动画 '执行动画
AniStart({ AniStart({
AaCode(Sub() AaCode(
AniControlEnabled += 1 Sub()
'把新页面添加进容器 AniControlEnabled += 1
PanMainLeft.Child = PageLeft '把新页面添加进容器
PageLeft.Opacity = 0 PanMainLeft.Child = PageLeft
PanMainLeft.Background = Nothing PageLeft.Opacity = 0
AniControlEnabled -= 1 PanMainLeft.Background = Nothing
RunInUi(Sub() PanMainLeft_Resize(PanMainLeft.ActualWidth), True) AniControlEnabled -= 1
End Sub, 130), RunInUi(Sub() PanMainLeft_Resize(PanMainLeft.ActualWidth), True)
AaCode(Sub() End Sub, 130),
'延迟触发页面通用动画,以使得在 Loaded 事件中加载的控件得以处理 AaCode(
PageLeft.Opacity = 1 Sub()
PageLeft.TriggerShowAnimation() '延迟触发页面通用动画,以使得在 Loaded 事件中加载的控件得以处理
End Sub, 30, True) PageLeft.Opacity = 1
PageLeft.TriggerShowAnimation()
End Sub, 30, True)
}, "FrmMain PageChangeLeft") }, "FrmMain PageChangeLeft")
AniStart({ AniStart({
AaCode(Sub() AaCode(
AniControlEnabled += 1 Sub()
CType(PanMainRight.Child, MyPageRight).PageOnForceExit() AniControlEnabled += 1
'把新页面添加进容器 CType(PanMainRight.Child, MyPageRight).PageOnForceExit()
PanMainRight.Child = PageRight '把新页面添加进容器
PageRight.Opacity = 0 PanMainRight.Child = PageRight
PanMainRight.Background = Nothing PageRight.Opacity = 0
AniControlEnabled -= 1 PanMainRight.Background = Nothing
RunInUi(Sub() BtnExtraBack.ShowRefresh(), True) AniControlEnabled -= 1
End Sub, 130), RunInUi(Sub() BtnExtraBack.ShowRefresh(), True)
AaCode(Sub() End Sub, 130),
'延迟触发页面通用动画,以使得在 Loaded 事件中加载的控件得以处理 AaCode(
PageRight.Opacity = 1 Sub()
PageRight.PageOnEnter() '延迟触发页面通用动画,以使得在 Loaded 事件中加载的控件得以处理
End Sub, 30, True) PageRight.Opacity = 1
PageRight.PageOnEnter()
End Sub, 30, True)
}, "FrmMain PageChangeRight") }, "FrmMain PageChangeRight")
End Sub End Sub
''' <summary> ''' <summary>
@@ -1448,12 +1277,12 @@ Install:
PanTitleMain.IsHitTestVisible = True PanTitleMain.IsHitTestVisible = True
PanTitleInner.IsHitTestVisible = False PanTitleInner.IsHitTestVisible = False
AniStart({ AniStart({
AaOpacity(PanTitleInner, -PanTitleInner.Opacity, 150), AaOpacity(PanTitleInner, -PanTitleInner.Opacity, 150),
AaX(PanTitleInner, -18 - PanTitleInner.Margin.Left, 150,, New AniEaseInFluent), AaX(PanTitleInner, -18 - PanTitleInner.Margin.Left, 150,, New AniEaseInFluent),
AaOpacity(PanTitleMain, 1 - PanTitleMain.Opacity, 150, 200), AaOpacity(PanTitleMain, 1 - PanTitleMain.Opacity, 150, 200),
AaX(PanTitleMain, -PanTitleMain.Margin.Left, 350, 200, New AniEaseOutBack(AniEasePower.Weak)), AaX(PanTitleMain, -PanTitleMain.Margin.Left, 350, 200, New AniEaseOutBack(AniEasePower.Weak)),
AaCode(Sub() PanTitleInner.Visibility = Visibility.Collapsed,, True) AaCode(Sub() PanTitleInner.Visibility = Visibility.Collapsed,, True)
}, "FrmMain Titlebar FirstLayer") }, "FrmMain Titlebar FirstLayer")
PageStack.Clear() PageStack.Clear()
Else Else
'主页面 → 主页面,无事发生 '主页面 → 主页面,无事发生
@@ -1472,16 +1301,16 @@ Install:
If NewWidth > 0 Then If NewWidth > 0 Then
'宽度足够,显示 '宽度足够,显示
AniStart({ AniStart({
AaWidth(RectLeftBackground, NewWidth - RectLeftBackground.Width, 400,, New AniEaseOutFluent(AniEasePower.ExtraStrong)), AaWidth(RectLeftBackground, NewWidth - RectLeftBackground.Width, 400,, New AniEaseOutFluent(AniEasePower.ExtraStrong)),
AaOpacity(RectLeftShadow, 1 - RectLeftShadow.Opacity, 200), AaOpacity(RectLeftShadow, 1 - RectLeftShadow.Opacity, 200),
AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 250) AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 250)
}, "FrmMain LeftChange", True) }, "FrmMain LeftChange", True)
Else Else
'宽度不足,隐藏 '宽度不足,隐藏
AniStart({ AniStart({
AaWidth(RectLeftBackground, -RectLeftBackground.Width, 200,, New AniEaseOutFluent), AaWidth(RectLeftBackground, -RectLeftBackground.Width, 200,, New AniEaseOutFluent),
AaOpacity(RectLeftShadow, -RectLeftShadow.Opacity, 200), AaOpacity(RectLeftShadow, -RectLeftShadow.Opacity, 200),
AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 170) AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 170)
}, "FrmMain LeftChange", True) }, "FrmMain LeftChange", True)
End If End If
Else Else

Before

Width:  |  Height:  |  Size: 2.2 KiB

After

Width:  |  Height:  |  Size: 2.2 KiB

File diff suppressed because it is too large Load Diff
@@ -91,17 +91,18 @@
_State = value _State = value
Log("[Loader] 加载器 " & Name & " 状态改变:" & GetStringFromEnum(value)) Log("[Loader] 加载器 " & Name & " 状态改变:" & GetStringFromEnum(value))
'实现 ILoadingTrigger 接口与 OnStateChanged 回调 '实现 ILoadingTrigger 接口与 OnStateChanged 回调
RunInUi(Sub() RunInUi(
Select Case value Sub()
Case LoadState.Loading Select Case value
LoadingState = MyLoading.MyLoadingState.Run Case LoadState.Loading
Case LoadState.Failed LoadingState = MyLoading.MyLoadingState.Run
LoadingState = MyLoading.MyLoadingState.Error Case LoadState.Failed
Case Else LoadingState = MyLoading.MyLoadingState.Error
LoadingState = MyLoading.MyLoadingState.Stop Case Else
End Select LoadingState = MyLoading.MyLoadingState.Stop
RaiseEvent OnStateChangedUi(Me, value, OldState) End Select
End Sub) RaiseEvent OnStateChangedUi(Me, value, OldState)
End Sub)
If HasOnStateChangedThread Then RunInThread(Sub() RaiseEvent OnStateChangedThread(Me, value, OldState)) If HasOnStateChangedThread Then RunInThread(Sub() RaiseEvent OnStateChangedThread(Me, value, OldState))
End Set End Set
End Property End Property
@@ -287,15 +288,13 @@
End SyncLock End SyncLock
End Try End Try
'检验输入以确定情况 '检验输入以确定情况
If (Not IsForceRestart) AndAlso '不要求强行重启 If IsForceRestart Then Return True '强制要求重启
((Input IsNot Nothing AndAlso Input.Equals(Me.Input)) OrElse (Input Is Nothing AndAlso Me.Input Is Nothing)) AndAlso '输入相同 If ((Input Is Nothing) <> (Me.Input Is Nothing)) OrElse (Input IsNot Nothing AndAlso Not Input.Equals(Me.Input)) Then Return True '输入不同
(State = LoadState.Loading OrElse State = LoadState.Finished) AndAlso '正在加载或已加载成功 If (State = LoadState.Loading OrElse State = LoadState.Finished) AndAlso '正在加载或已结束
(IgnoreReloadTimeout OrElse ReloadTimeout = -1 OrElse LastFinishedTime = 0 OrElse GetTimeTick() - LastFinishedTime < ReloadTimeout) Then '没有超时 (IgnoreReloadTimeout OrElse ReloadTimeout = -1 OrElse LastFinishedTime = 0 OrElse GetTimeTick() - LastFinishedTime < ReloadTimeout) Then '没有超时
'如果输入相同且未出错则不重试 Return False '则不重试
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)
@@ -316,23 +315,26 @@
Sub() Sub()
Try Try
IsForceRestarting = IsForceRestart IsForceRestarting = IsForceRestart
If ModeDebug Then Log("[Loader] 加载线程 " & Name & " (" & Thread.CurrentThread.ManagedThreadId & ") 已启动") If ModeDebug Then Log($"[Loader] 加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已{If(IsForceRestarting, "强制", "")}启动")
LoadDelegate(Me) LoadDelegate(Me)
If IsAborted Then If IsAborted 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)
Else Else
RaisePreviewFinish() RaisePreviewFinish()
State = LoadState.Finished State = LoadState.Finished
LastFinishedTime = GetTimeTick() '未中断,本次输出有效 LastFinishedTime = GetTimeTick() '未中断,本次输出有效
End If End If
Catch ex As CancelledException
If ModeDebug Then Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发取消中断,已完成 {Math.Round(Progress * 100)}%")
If Not IsAborted Then State = LoadState.Aborted
Catch ex As ThreadInterruptedException Catch ex As ThreadInterruptedException
If ModeDebug Then Log(ex, "加载线程 " & Name & " (" & Thread.CurrentThread.ManagedThreadId & ") 已触发线程中断") If ModeDebug Then Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 已触发线程中断,已完成 {Math.Round(Progress * 100)}%")
'如果线程是因为判断到 IsAborted 而提前中止,则代表已有新线程被重启,此时不应当改为 Aborted '如果线程是因为判断到 IsAborted 而提前中止,则代表已有新线程被重启,此时不应当改为 Aborted
'如果线程是在没有 IsAborted 时手动引发了 ThreadInterruptedException,则代表没有重启线程,这通常代表用户手动取消,应当改为 Aborted '如果线程是在没有 IsAborted 时手动引发了 ThreadInterruptedException,则代表没有重启线程,这通常代表用户手动取消,应当改为 Aborted
If Not IsAborted Then State = LoadState.Aborted If Not IsAborted Then State = LoadState.Aborted
Catch ex As Exception Catch ex As Exception
If IsAborted Then Exit Sub If IsAborted Then Exit Sub
Log(ex, "加载线程 " & Name & " (" & Thread.CurrentThread.ManagedThreadId & ") 发生运行时错误", LogLevel.Developer) Log(ex, $"加载线程 {Name} ({Thread.CurrentThread.ManagedThreadId}) 出错,已完成 {Math.Round(Progress * 100)}%", LogLevel.Developer)
[Error] = ex [Error] = ex
State = LoadState.Failed State = LoadState.Failed
End Try End Try
@@ -348,7 +350,7 @@
End Sub End Sub
Private Sub TriggerThreadAbort() Private Sub TriggerThreadAbort()
If LastRunningThread Is Nothing Then Exit Sub If LastRunningThread Is Nothing Then Exit Sub
If ModeDebug Then Log("[Loader] 加载线程 " & Name & " (" & LastRunningThread.ManagedThreadId & ") 已中断") If ModeDebug Then Log($"[Loader] 加载线程 {Name} ({LastRunningThread.ManagedThreadId}) 已中断")
If LastRunningThread.IsAlive Then LastRunningThread.Interrupt() If LastRunningThread.IsAlive Then LastRunningThread.Interrupt()
LastRunningThread = Nothing LastRunningThread = Nothing
End Sub End Sub
@@ -440,12 +442,13 @@
Exit Sub Exit Sub
End If End If
End SyncLock End SyncLock
RunInThread(Sub() RunInThread(
'中断加载器 Sub()
For Each Loader In Loaders '中断加载器
Loader.Abort() For Each Loader In Loaders
Next Loader.Abort()
End Sub) Next
End Sub)
End Sub End Sub
''' <summary> ''' <summary>
@@ -484,7 +487,7 @@
Private Sub Update() Private Sub Update()
If State = LoadState.Finished OrElse State = LoadState.Failed OrElse State = LoadState.Aborted Then Exit Sub If State = LoadState.Finished OrElse State = LoadState.Failed OrElse State = LoadState.Aborted Then Exit Sub
Dim IsFinished As Boolean = True Dim IsFinished As Boolean = True
Dim Ignore As Boolean = False Dim Blocked As Boolean = False
Dim Input As Object = Me.Input Dim Input As Object = Me.Input
For Each Loader In Loaders For Each Loader In Loaders
Select Case Loader.State Select Case Loader.State
@@ -492,28 +495,30 @@
'检查是否需要重启 '检查是否需要重启
If Loader.GetType.Name.StartsWithF("LoaderTask") Then '类型名后面带有泛型,必须用 StartsWith If Loader.GetType.Name.StartsWithF("LoaderTask") Then '类型名后面带有泛型,必须用 StartsWith
If CType(Loader, Object).ShouldStart(If(Input IsNot Nothing AndAlso Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IgnoreReloadTimeout:=True) Then If CType(Loader, Object).ShouldStart(If(Input IsNot Nothing AndAlso Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IgnoreReloadTimeout:=True) Then
If ModeDebug Then Log("[Loader] 由于输入条件变更,重启已完成的加载器 " & Loader.Name) Log("[Loader] 由于输入条件变更,重启已完成的加载器 " & Loader.Name)
GoTo Restart GoTo Restart
End If End If
'更新下一个加载器的输入 '更新下一个加载器的输入
Input = CType(Loader, Object).Output Input = CType(Loader, Object).Output
End If End If
'如果不让继续启动,且已有加载器正在加载中,就不继续启动
If Loader.Block AndAlso Not IsFinished Then Blocked = True
Case LoadState.Loading Case LoadState.Loading
'检查是否需要重启 '检查是否需要重启
If Loader.GetType.Name.StartsWithF("LoaderTask") Then If Loader.GetType.Name.StartsWithF("LoaderTask") Then
If CType(Loader, Object).ShouldStart(If(Input IsNot Nothing AndAlso Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IgnoreReloadTimeout:=True) Then If CType(Loader, Object).ShouldStart(If(Input IsNot Nothing AndAlso Loader.GetType.GenericTypeArguments.First Is Input.GetType, Input, Nothing), IgnoreReloadTimeout:=True) Then
If ModeDebug Then Log("[Loader] 由于输入条件变更,重启进行中的加载器 " & Loader.Name, LogLevel.Developer) Log("[Loader] 由于输入条件变更,重启进行中的加载器 " & Loader.Name, LogLevel.Developer)
GoTo Restart GoTo Restart
End If End If
End If End If
'已经有正在加载中的了,不需要再启动了 '已经有正在加载中的了,不需要再启动了
IsFinished = False IsFinished = False
Ignore = True Blocked = True
Case Else Case Else
Restart: Restart:
'未启动,则启动加载器 '未启动,则启动加载器
IsFinished = False IsFinished = False
If Ignore Then Continue For If Blocked Then Continue For
If Input IsNot Nothing Then If Input IsNot Nothing Then
'若输入类型与下一个加载器相同才继续 '若输入类型与下一个加载器相同才继续
Dim LoaderType As String = Loader.GetType.Name Dim LoaderType As String = Loader.GetType.Name
@@ -527,8 +532,8 @@ Restart:
Else Else
Loader.Start(IsForceRestart:=IsForceRestarting) Loader.Start(IsForceRestart:=IsForceRestarting)
End If End If
'如果不让继续启动,那就不启动呗 '阻止继续
If Loader.Block Then Ignore = True If Loader.Block Then Blocked = True
End Select End Select
Next Next
If IsFinished Then If IsFinished Then
@@ -566,7 +571,7 @@ Restart:
End Class End Class
'任务栏进度条 '任务栏进度条
Public LoaderTaskbar As New Concurrent.ConcurrentBag(Of LoaderBase) Public LoaderTaskbar As New SafeList(Of LoaderBase)
Public LoaderTaskbarProgress As Double = 0 '平滑后的进度 Public LoaderTaskbarProgress As Double = 0 '平滑后的进度
Private LoaderTaskbarProgressLast As Shell.TaskbarItemProgressState = Shell.TaskbarItemProgressState.None Private LoaderTaskbarProgressLast As Shell.TaskbarItemProgressState = Shell.TaskbarItemProgressState.None
@@ -582,14 +587,14 @@ Restart:
'检查任务是否完成,若完成则移除 '检查任务是否完成,若完成则移除
'外显任务是否已经全部完成 '外显任务是否已经全部完成
Dim IsAllDownloadTaskCompleted As Boolean = True Dim IsAllDownloadTaskCompleted As Boolean = True
For Each Loader In LoaderTaskbar For Each Loader In LoaderTaskbar.ToList()
If Loader.State = LoadState.Loading Then IsAllDownloadTaskCompleted = False If Loader.State = LoadState.Loading Then IsAllDownloadTaskCompleted = False
Next Next
'若单个任务已中止或全部任务已完成,则刷新并移除 '若单个任务已中止或全部任务已完成,则刷新并移除
For Each Task In LoaderTaskbar.ToList() For Each Task In LoaderTaskbar.ToList()
If IsAllDownloadTaskCompleted OrElse Task.State = LoadState.Aborted OrElse Task.State = LoadState.Waiting Then If IsAllDownloadTaskCompleted OrElse Task.State = LoadState.Aborted OrElse Task.State = LoadState.Waiting Then
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRefresh(Task) If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRefresh(Task)
LoaderTaskbar.TryTake(Task) LoaderTaskbar.Remove(Task)
Log($"[Taskbar] {Task.Name} 已移出任务列表") Log($"[Taskbar] {Task.Name} 已移出任务列表")
End If End If
Next Next
+158 -130
View File
@@ -1,6 +1,4 @@
Imports System.Net Public Module ModNet
Public Module ModNet
Public Const NetDownloadEnd As String = ".PCLDownloading" Public Const NetDownloadEnd As String = ".PCLDownloading"
''' <summary> ''' <summary>
@@ -140,20 +138,21 @@ Retry:
''' </summary> ''' </summary>
''' <param name="Url">网页的 Url。</param> ''' <param name="Url">网页的 Url。</param>
''' <param name="Encode">网页的编码,通常为 UTF-8。</param> ''' <param name="Encode">网页的编码,通常为 UTF-8。</param>
Public Function NetGetCodeByRequestMulty(Url As String, Optional Encode As Encoding = Nothing, Optional Accept As String = "", Optional IsJson As Boolean = False) Public Function NetGetCodeByRequestMultiple(Url As String, Optional Encode As Encoding = Nothing, Optional Accept As String = "", Optional IsJson As Boolean = False)
Dim Threads As New List(Of Thread) Dim Threads As New List(Of Thread)
Dim RequestResult = Nothing Dim RequestResult = Nothing
Dim RequestEx As Exception = Nothing Dim RequestEx As Exception = Nothing
Dim FailCount As Integer = 0 Dim FailCount As Integer = 0
For i = 1 To 4 For i = 1 To 4
Dim th As New Thread(Sub() Dim th As New Thread(
Try Sub()
RequestResult = NetGetCodeByRequestOnce(Url, Encode, 30000, IsJson, Accept) Try
Catch ex As Exception RequestResult = NetGetCodeByRequestOnce(Url, Encode, 30000, IsJson, Accept)
FailCount += 1 Catch ex As Exception
RequestEx = ex FailCount += 1
End Try RequestEx = ex
End Sub) End Try
End Sub)
th.Start() th.Start()
Threads.Add(th) Threads.Add(th)
Thread.Sleep(i * 250) Thread.Sleep(i * 250)
@@ -220,12 +219,12 @@ RequestFinished:
''' 以多线程下载网页文件的方式获取网页源代码。 ''' 以多线程下载网页文件的方式获取网页源代码。
''' </summary> ''' </summary>
''' <param name="Url">网页的 Url。</param> ''' <param name="Url">网页的 Url。</param>
Public Function NetGetCodeByDownload(Url As String, Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False, Optional UseBrowserUserAgent As Boolean = False) As String Public Function NetGetCodeByLoader(Url As String, Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False, Optional UseBrowserUserAgent As Boolean = False) As String
Dim Temp As String = PathTemp & "Cache\Code\" & Url.GetHashCode() & "_" & GetUuid() Dim Temp As String = RequestTaskTempFolder() & "download.txt"
Dim NewTask As New LoaderDownload("源码获取 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile({Url}, Temp, New FileChecker With {.IsJson = IsJson}, UseBrowserUserAgent)}) Dim NewTask As New LoaderDownload("源码获取 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile({Url}, Temp, New FileChecker With {.IsJson = IsJson}, UseBrowserUserAgent)})
Try Try
NewTask.WaitForExitTime(Timeout, TimeoutMessage:="连接服务器超时(" & Url & ")") NewTask.WaitForExitTime(Timeout, TimeoutMessage:="连接服务器超时(" & Url & ")")
NetGetCodeByDownload = ReadFile(Temp) NetGetCodeByLoader = ReadFile(Temp)
File.Delete(Temp) File.Delete(Temp)
Finally Finally
NewTask.Abort() NewTask.Abort()
@@ -235,12 +234,12 @@ RequestFinished:
''' 以多线程下载网页文件的方式获取网页源代码。 ''' 以多线程下载网页文件的方式获取网页源代码。
''' </summary> ''' </summary>
''' <param name="Urls">网页的 Url 列表。</param> ''' <param name="Urls">网页的 Url 列表。</param>
Public Function NetGetCodeByDownload(Urls As IEnumerable(Of String), Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False, Optional UseBrowserUserAgent As Boolean = False) As String Public Function NetGetCodeByLoader(Urls As IEnumerable(Of String), Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False, Optional UseBrowserUserAgent As Boolean = False) As String
Dim Temp As String = PathTemp & "Cache\Code\" & Urls.First.GetHashCode() & "_" & GetUuid() Dim Temp As String = RequestTaskTempFolder() & "download.txt"
Dim NewTask As New LoaderDownload("源码获取 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile(Urls, Temp, New FileChecker With {.IsJson = IsJson}, UseBrowserUserAgent)}) Dim NewTask As New LoaderDownload("源码获取 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile(Urls, Temp, New FileChecker With {.IsJson = IsJson}, UseBrowserUserAgent)})
Try Try
NewTask.WaitForExitTime(Timeout, TimeoutMessage:="连接服务器超时(第一下载源:" & Urls.First & ")") NewTask.WaitForExitTime(Timeout, TimeoutMessage:="连接服务器超时(第一下载源:" & Urls.First & ")")
NetGetCodeByDownload = ReadFile(Temp) NetGetCodeByLoader = ReadFile(Temp)
File.Delete(Temp) File.Delete(Temp)
Finally Finally
NewTask.Abort() NewTask.Abort()
@@ -248,13 +247,12 @@ RequestFinished:
End Function End Function
''' <summary> ''' <summary>
''' 从网络中直接下载文件。这不能下载 CDN 中的文件。 ''' 使用 WebClient 从网络中下载文件。这不能下载 CDN 中的文件。
''' </summary> ''' </summary>
''' <param name="Url">网络 Url。</param> ''' <param name="Url">网络 Url。</param>
''' <param name="LocalFile">下载的本地地址。</param> ''' <param name="LocalFile">下载的本地地址。</param>
Public Sub NetDownload(Url As String, LocalFile As String, Optional UseBrowserUserAgent As Boolean = False) Public Sub NetDownloadByClient(Url As String, LocalFile As String, Optional UseBrowserUserAgent As Boolean = False)
Log("[Net] 直接下载文件:" & Url) Log("[Net] 直接下载文件:" & Url)
'初始化 '初始化
Try Try
'建立目录 '建立目录
@@ -262,9 +260,8 @@ RequestFinished:
'尝试删除原文件 '尝试删除原文件
File.Delete(LocalFile) File.Delete(LocalFile)
Catch ex As Exception Catch ex As Exception
Throw New WebException("预处理下载文件路径失败(" & LocalFile & ")。", ex) Throw New WebException($"预处理下载文件路径失败({LocalFile})", ex)
End Try End Try
'下载 '下载
Using Client As New WebClient Using Client As New WebClient
Try Try
@@ -272,10 +269,41 @@ RequestFinished:
Client.DownloadFile(Url, LocalFile) Client.DownloadFile(Url, LocalFile)
Catch ex As Exception Catch ex As Exception
File.Delete(LocalFile) File.Delete(LocalFile)
Throw New WebException("直接下载文件失败(" & Url & ")。", ex) Throw New WebException($"直接下载文件失败({Url})", ex)
End Try End Try
End Using End Using
End Sub
''' <summary>
''' 简单的多线程下载文件。可以下载 CDN 中的文件。
''' </summary>
''' <param name="Url">文件的 Url。</param>
''' <param name="LocalFile">下载的本地地址。</param>
Public Sub NetDownloadByLoader(Url As String, LocalFile As String, Optional LoaderToSyncProgress As LoaderBase = Nothing, Optional Check As FileChecker = Nothing, Optional UseBrowserUserAgent As Boolean = False)
Dim NewTask As New LoaderDownload("文件下载 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile({Url}, LocalFile, Check, UseBrowserUserAgent)})
Try
NewTask.WaitForExit(LoaderToSyncProgress:=LoaderToSyncProgress)
Catch ex As Exception
Throw New WebException($"多线程直接下载文件失败({Url})", ex)
Finally
NewTask.Abort()
End Try
End Sub
''' <summary>
''' 简单的多线程下载文件。可以下载 CDN 中的文件。
''' </summary>
''' <param name="Urls">文件的 Url 列表。</param>
''' <param name="LocalFile">下载的本地地址。</param>
Public Sub NetDownloadByLoader(Urls As IEnumerable(Of String), LocalFile As String, Optional LoaderToSyncProgress As LoaderBase = Nothing, Optional Check As FileChecker = Nothing, Optional UseBrowserUserAgent As Boolean = False)
Dim NewTask As New LoaderDownload("文件下载 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile(Urls, LocalFile, Check, UseBrowserUserAgent)})
Try
NewTask.WaitForExit(LoaderToSyncProgress:=LoaderToSyncProgress)
Catch ex As Exception
Throw New WebException($"多线程直接下载文件失败(第一下载源:" & Urls.First() & ")", ex)
Finally
NewTask.Abort()
End Try
End Sub End Sub
''' <summary> ''' <summary>
@@ -329,7 +357,7 @@ Retry:
''' <summary> ''' <summary>
''' 同时发送多个网络请求并要求返回内容。 ''' 同时发送多个网络请求并要求返回内容。
''' </summary> ''' </summary>
Public Function NetRequestMulty(Url As String, Method As String, Data As Object, ContentType As String, Optional RequestCount As Integer = 4, Optional Headers As Dictionary(Of String, String) = Nothing) Public Function NetRequestMultiple(Url As String, Method As String, Data As Object, ContentType As String, Optional RequestCount As Integer = 4, Optional Headers As Dictionary(Of String, String) = Nothing, Optional MakeLog As Boolean = True)
Dim Threads As New List(Of Thread) Dim Threads As New List(Of Thread)
Dim RequestResult = Nothing Dim RequestResult = Nothing
Dim RequestEx As Exception = Nothing Dim RequestEx As Exception = Nothing
@@ -338,7 +366,7 @@ Retry:
Dim th As New Thread( Dim th As New Thread(
Sub() Sub()
Try Try
RequestResult = NetRequestOnce(Url, Method, Data, ContentType, 30000, Headers) RequestResult = NetRequestOnce(Url, Method, Data, ContentType, 30000, Headers, MakeLog)
Catch ex As Exception Catch ex As Exception
FailCount += 1 FailCount += 1
RequestEx = ex RequestEx = ex
@@ -701,12 +729,11 @@ RequestFinished:
''' <summary> ''' <summary>
''' 所属的文件列表任务。 ''' 所属的文件列表任务。
''' </summary> ''' </summary>
Public Tasks As New Concurrent.ConcurrentBag(Of LoaderDownload) Public Tasks As New SafeList(Of LoaderDownload)
''' <summary> ''' <summary>
''' 所有下载源。 ''' 所有下载源。
''' </summary> ''' </summary>
Public Sources As NetSource() Public Sources As SafeList(Of NetSource)
''' <summary> ''' <summary>
''' 用于在第一个线程出错时切换下载源。 ''' 用于在第一个线程出错时切换下载源。
''' </summary> ''' </summary>
@@ -714,7 +741,7 @@ RequestFinished:
''' <summary> ''' <summary>
''' 所有已经被标记为失败的,但未完整尝试过的,不允许断点续传的下载源。 ''' 所有已经被标记为失败的,但未完整尝试过的,不允许断点续传的下载源。
''' </summary> ''' </summary>
Public SourcesOnce As New List(Of NetSource) Public SourcesOnce As New SafeList(Of NetSource)
''' <summary> ''' <summary>
''' 获取从某个源开始,第一个可用的源。 ''' 获取从某个源开始,第一个可用的源。
''' </summary> ''' </summary>
@@ -915,7 +942,7 @@ RequestFinished:
Sources.Add(New NetSource With {.FailCount = 0, .Url = SecretCdnSign(Source.Replace(vbCr, "").Replace(vbLf, "").Trim), .Id = Count, .IsFailed = False, .Ex = Nothing}) Sources.Add(New NetSource With {.FailCount = 0, .Url = SecretCdnSign(Source.Replace(vbCr, "").Replace(vbLf, "").Trim), .Id = Count, .IsFailed = False, .Ex = Nothing})
Count += 1 Count += 1
Next Next
Me.Sources = Sources.ToArray Me.Sources = Sources
Me.LocalPath = LocalPath Me.LocalPath = LocalPath
Me.Check = Check Me.Check = Check
Me.UseBrowserUserAgent = UseBrowserUserAgent Me.UseBrowserUserAgent = UseBrowserUserAgent
@@ -931,7 +958,7 @@ RequestFinished:
'条件检测 '条件检测
If NetTaskThreadCount >= NetTaskThreadLimit OrElse IsSourceFailed() OrElse If NetTaskThreadCount >= NetTaskThreadLimit OrElse IsSourceFailed() OrElse
(IsNoSplit AndAlso Threads IsNot Nothing AndAlso Threads.State <> NetState.Error) Then Return Nothing (IsNoSplit AndAlso Threads IsNot Nothing AndAlso Threads.State <> NetState.Error) Then Return Nothing
If State >= NetState.Merge OrElse State = NetState.WaitForCheck Then Return Nothing If State >= NetState.Merge OrElse State = NetState.WaitForCheck Then Return Nothing
SyncLock LockState SyncLock LockState
If State < NetState.Connect Then State = NetState.Connect If State < NetState.Connect Then State = NetState.Connect
@@ -940,7 +967,6 @@ RequestFinished:
Dim StartPosition As Long, StartSource As NetSource = Nothing Dim StartPosition As Long, StartSource As NetSource = Nothing
Dim Th As Thread, ThreadInfo As NetThread Dim Th As Thread, ThreadInfo As NetThread
SyncLock LockChain SyncLock LockChain
'获取线程起点与下载源 '获取线程起点与下载源
'不分割 '不分割
If IsNoSplit Then GoTo Capture If IsNoSplit Then GoTo Capture
@@ -976,7 +1002,8 @@ Capture:
Next Next
'是否禁用多线程,以及规定碎片大小 '是否禁用多线程,以及规定碎片大小
Dim TargetUrl As String = GetSource().Url Dim TargetUrl As String = GetSource().Url
If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("gitcode.net") OrElse TargetUrl.Contains("github.com") OrElse TargetUrl.Contains("modrinth") Then Return Nothing If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("bmclapi") OrElse TargetUrl.Contains("github.com") OrElse
TargetUrl.Contains("optifine.net") OrElse TargetUrl.Contains("modrinth") Then Return Nothing
'寻找最大碎片 '寻找最大碎片
'FUTURE: 下载引擎重做,计算下载源平均链接时间和线程下载速度,按最高时间节省来开启多线程 'FUTURE: 下载引擎重做,计算下载源平均链接时间和线程下载速度,按最高时间节省来开启多线程
Dim FilePieceMax As NetThread = Threads Dim FilePieceMax As NetThread = Threads
@@ -1050,6 +1077,15 @@ StartThread:
If ModeDebug AndAlso HttpResponse.ResponseUri.OriginalString <> Info.Source.Url Then If ModeDebug AndAlso HttpResponse.ResponseUri.OriginalString <> Info.Source.Url Then
Log($"[Download] {LocalName} {Info.Uuid}#:重定向至 {HttpResponse.ResponseUri.OriginalString}") Log($"[Download] {LocalName} {Info.Uuid}#:重定向至 {HttpResponse.ResponseUri.OriginalString}")
End If End If
''从响应头获取文件名
'If Info.IsFirstThread Then
' Dim FileName As String = GetFileNameFromResponse(HttpResponse)
' If ModeDebug Then Log($"[Download] {LocalName} {Info.Uuid}#:远程文件名:{If(FileName, "未提供")}")
' If FileName IsNot Nothing AndAlso LocalName = "待定" Then
' LocalName = FileName
' Log($"[Download] {LocalName} {Info.Uuid}#:从响应头获取到文件名")
' End If
'End If
'文件大小校验 '文件大小校验
ContentLength = HttpResponse.ContentLength ContentLength = HttpResponse.ContentLength
If ContentLength = -1 Then If ContentLength = -1 Then
@@ -1114,7 +1150,7 @@ NotSupportRange:
Info.Temp = Nothing Info.Temp = Nothing
SmailFileCache = New Queue(Of Byte) SmailFileCache = New Queue(Of Byte)
Else Else
Info.Temp = PathTemp & "Download\" & Uuid & "_" & Info.Uuid & "_" & RandomInteger(0, 999999) & ".tmp" Info.Temp = $"{PathTemp}Download\{Uuid}_{Info.Uuid}_{RandomInteger(0, 999999)}.tmp"
ResultStream = New FileStream(Info.Temp, FileMode.Create, FileAccess.Write, FileShare.Read) ResultStream = New FileStream(Info.Temp, FileMode.Create, FileAccess.Write, FileShare.Read)
End If End If
'开始下载 '开始下载
@@ -1134,7 +1170,7 @@ NotSupportRange:
If NetTaskSpeedLimitHigh > 0 Then NetTaskSpeedLimitLeft -= RealDataCount If NetTaskSpeedLimitHigh > 0 Then NetTaskSpeedLimitLeft -= RealDataCount
End SyncLock End SyncLock
Dim DeltaTime = GetTimeTick() - Info.LastReceiveTime Dim DeltaTime = GetTimeTick() - Info.LastReceiveTime
If DeltaTime > 1000000 Then DeltaTime = 0 '时间刻反转导致出现极大值 If DeltaTime > 1000000 Then DeltaTime = 1 '时间刻反转导致出现极大值
If RealDataCount > 0 Then If RealDataCount > 0 Then
'有数据 '有数据
If Info.DownloadDone = 0 Then If Info.DownloadDone = 0 Then
@@ -1175,7 +1211,7 @@ NotSupportRange:
ResultStream.Write(HttpData, 0, RealDataCount) ResultStream.Write(HttpData, 0, RealDataCount)
End If End If
'检查速度是否过慢 '检查速度是否过慢
If DeltaTime > 1000 AndAlso DeltaTime > RealDataCount Then '数据包间隔大于 1s,且速度小于 1K/s If DeltaTime > 1500 AndAlso DeltaTime > RealDataCount Then '数据包间隔大于 1.5s,且速度小于 1.5K/s
Throw New TimeoutException("由于速度过慢断开链接,下载 " & RealDataCount & " B,消耗 " & DeltaTime & " ms。") Throw New TimeoutException("由于速度过慢断开链接,下载 " & RealDataCount & " B,消耗 " & DeltaTime & " ms。")
End If End If
Info.LastReceiveTime = GetTimeTick() Info.LastReceiveTime = GetTimeTick()
@@ -1287,6 +1323,17 @@ Wrong:
If ((FileSize >= 0 AndAlso DownloadDone >= FileSize) OrElse (FileSize = -1 AndAlso DownloadDone > 0)) AndAlso State < NetState.Merge Then Merge() If ((FileSize >= 0 AndAlso DownloadDone >= FileSize) OrElse (FileSize = -1 AndAlso DownloadDone > 0)) AndAlso State < NetState.Merge Then Merge()
End Try End Try
End Sub End Sub
''' <summary>
''' 从 HTTP 响应头中获取文件名。
''' 如果没有,返回 Nothing。
''' </summary>
Private Function GetFileNameFromResponse(response As HttpWebResponse) As String
Dim header As String = response.Headers("Content-Disposition")
If String.IsNullOrEmpty(header) Then Return Nothing
'attachment; filename="filename.ext"
If Not header.Contains("filename=") Then Return Nothing
Return header.AfterLast("filename=").Trim(""""c, " "c).BeforeFirst(";")
End Function
'下载文件的最终收束事件 '下载文件的最终收束事件
''' <summary> ''' <summary>
@@ -1344,7 +1391,7 @@ Retry:
If Check.ActualSize = -1 Then If Check.ActualSize = -1 Then
Check.ActualSize = FileSize Check.ActualSize = FileSize
ElseIf Check.ActualSize <> FileSize Then ElseIf Check.ActualSize <> FileSize Then
Throw New Exception("文件大小不一致:任务要求为 " & Check.ActualSize & " B,网络获取结果为 " & FileSize & "B") Throw New Exception($"文件大小不一致:任务要求为 {Check.ActualSize} B,网络获取结果为 {FileSize}B")
End If End If
End If End If
'检查文件 '检查文件
@@ -1403,7 +1450,7 @@ Retry:
''' </summary> ''' </summary>
Public Sub Abort(CausedByTask As LoaderDownload) Public Sub Abort(CausedByTask As LoaderDownload)
'从特定任务中移除,如果它还属于其他任务,则继续下载 '从特定任务中移除,如果它还属于其他任务,则继续下载
Tasks.TryTake(CausedByTask) Tasks.Remove(CausedByTask)
If Tasks.Any Then Exit Sub If Tasks.Any Then Exit Sub
'确认中断 '确认中断
SyncLock LockState SyncLock LockState
@@ -1451,8 +1498,7 @@ Retry:
''' <summary> ''' <summary>
''' 需要下载的文件。 ''' 需要下载的文件。
''' </summary> ''' </summary>
Public Files As List(Of NetFile) Public Files As SafeList(Of NetFile)
Private ReadOnly FilesLock As New Object
''' <summary> ''' <summary>
''' 剩余未完成的文件数。(用于减轻 FilesLock 的占用) ''' 剩余未完成的文件数。(用于减轻 FilesLock 的占用)
''' </summary> ''' </summary>
@@ -1465,9 +1511,7 @@ Retry:
Public Overrides Property Progress As Double Public Overrides Property Progress As Double
Get Get
If State >= LoadState.Finished Then Return 1 If State >= LoadState.Finished Then Return 1
SyncLock FilesLock If Not Files.Any() Then Return 0 '必须返回 0,否则在获取列表的时候会错觉已经下载完了
If Not Files.Any() Then Return 0 '必须返回 0,否则在获取列表的时候会错觉已经下载完了
End SyncLock
Return _Progress Return _Progress
End Get End Get
Set(value As Double) Set(value As Double)
@@ -1489,16 +1533,14 @@ Retry:
Log("[Download] 由于同加载器中失败次数过多引发强制失败:连续失败了 " & value & " 次", LogLevel.Debug) Log("[Download] 由于同加载器中失败次数过多引发强制失败:连续失败了 " & value & " 次", LogLevel.Debug)
On Error Resume Next On Error Resume Next
Dim ExList As New List(Of Exception) Dim ExList As New List(Of Exception)
SyncLock FilesLock For Each File In Files
For Each File In Files For Each Source In File.Sources
For Each Source In File.Sources If Source.Ex IsNot Nothing Then
If Source.Ex IsNot Nothing Then ExList.Add(Source.Ex)
ExList.Add(Source.Ex) If ExList.Count > 10 Then GoTo FinishExCatch
If ExList.Count > 10 Then GoTo FinishExCatch End If
End If
Next
Next Next
End SyncLock Next
FinishExCatch: FinishExCatch:
OnFail(ExList) OnFail(ExList)
End If End If
@@ -1515,46 +1557,41 @@ FinishExCatch:
'计算进度 '计算进度
Dim NewProgress As Double = 0 Dim NewProgress As Double = 0
Dim TotalProgress As Double = 0 Dim TotalProgress As Double = 0
SyncLock FilesLock For Each File In Files
For Each File In Files If File.IsCopy Then
If File.IsCopy Then NewProgress += File.Progress * 0.2
NewProgress += File.Progress * 0.2 TotalProgress += 0.2
TotalProgress += 0.2 Else
Else NewProgress += File.Progress
NewProgress += File.Progress TotalProgress += 1
TotalProgress += 1 End If
End If Next
Next If TotalProgress > 0 AndAlso Not Double.IsNaN(TotalProgress) Then NewProgress /= TotalProgress
End SyncLock
If TotalProgress > 0 Then NewProgress /= TotalProgress
'刷新进度 '刷新进度
If NewProgress < 1 AndAlso NewProgress > 0 Then NewProgress = 2 * (NewProgress ^ 3) - 3 * (NewProgress ^ 2) + 2 * NewProgress '2x^3-3x^2+2x,模拟开头和结尾更慢的情况
_Progress = NewProgress _Progress = NewProgress
End Sub End Sub
Public Sub New(Name As String, FileTasks As List(Of NetFile)) Public Sub New(Name As String, FileTasks As List(Of NetFile))
Me.Name = Name Me.Name = Name
Files = FileTasks Files = New SafeList(Of NetFile)(FileTasks)
End Sub End Sub
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)
SyncLock FilesLock If Input IsNot Nothing Then Files = New SafeList(Of NetFile)(Input)
If Input IsNot Nothing Then Files = Input '去重
'去重 Dim ResultArray As New SafeList(Of NetFile)
Dim ResultArray As New List(Of NetFile) For i = 0 To Files.Count - 1
For i = 0 To Files.Count - 1 For ii = i + 1 To Files.Count - 1
For ii = i + 1 To Files.Count - 1 If Files(i).LocalPath = Files(ii).LocalPath Then GoTo NextElement
If Files(i).LocalPath = Files(ii).LocalPath Then GoTo NextElement Next
Next ResultArray.Add(Files(i))
ResultArray.Add(Files(i))
NextElement: NextElement:
Next i Next
Files = ResultArray Files = ResultArray
'设置剩余文件数 '设置剩余文件数
SyncLock FileRemainLock SyncLock FileRemainLock
For Each File In Files For Each File In Files
If File.State <> NetState.Finish Then FileRemain += 1 If File.State <> NetState.Finish Then FileRemain += 1
Next Next
End SyncLock
End SyncLock End SyncLock
State = LoadState.Loading State = LoadState.Loading
'开始执行 '开始执行
@@ -1597,25 +1634,23 @@ NextElement:
Next Next
End If End If
'最多 5 个线程,最少每个线程分配 10 个文件 '最多 5 个线程,最少每个线程分配 10 个文件
SyncLock FilesLock Dim FilesPerThread As Integer = Math.Max(5, Files.Count / 10 + 1)
Dim FilesPerThread As Integer = Math.Max(5, Files.Count / 10 + 1) Dim FilesInThread As New List(Of NetFile)
Dim FilesInThread As New List(Of NetFile) For Each File In Files
For Each File In Files FilesInThread.Add(File)
FilesInThread.Add(File) If FilesInThread.Count = FilesPerThread Then
If FilesInThread.Count = FilesPerThread Then
Dim FilesToRun As New List(Of NetFile)
FilesToRun.AddRange(FilesInThread)
RunInNewThread(Sub() StartCopy(FilesToRun, FoldersFinal), "NetTask FileCopy " & Uuid)
FilesInThread.Clear()
End If
Next
If FilesInThread.Any Then
Dim FilesToRun As New List(Of NetFile) Dim FilesToRun As New List(Of NetFile)
FilesToRun.AddRange(FilesInThread) FilesToRun.AddRange(FilesInThread)
RunInNewThread(Sub() StartCopy(FilesToRun, FoldersFinal), "NetTask FileCopy " & Uuid) RunInNewThread(Sub() StartCopy(FilesToRun, FoldersFinal), "NetTask FileCopy " & Uuid)
FilesInThread.Clear() FilesInThread.Clear()
End If End If
End SyncLock Next
If FilesInThread.Any Then
Dim FilesToRun As New List(Of NetFile)
FilesToRun.AddRange(FilesInThread)
RunInNewThread(Sub() StartCopy(FilesToRun, FoldersFinal), "NetTask FileCopy " & Uuid)
FilesInThread.Clear()
End If
Catch ex As Exception Catch ex As Exception
OnFail(New List(Of Exception) From {ex}) OnFail(New List(Of Exception) From {ex})
End Try End Try
@@ -1654,6 +1689,9 @@ NextElement:
'复制已存在的文件 '复制已存在的文件
For Each FileToken In ExistFiles For Each FileToken In ExistFiles
Dim File As NetFile = FileToken.Key Dim File As NetFile = FileToken.Key
SyncLock LockState
If File.State > NetState.WaitForCopy Then Exit Sub
End SyncLock
Dim LocalPath As String = FileToken.Value Dim LocalPath As String = FileToken.Value
Dim RetryCount As Integer = 0 Dim RetryCount As Integer = 0
Retry: Retry:
@@ -1707,24 +1745,20 @@ Retry:
Dim UsefulExs = ExList.Where(Function(e) Not e.Message.Contains("(404)")).ToList Dim UsefulExs = ExList.Where(Function(e) Not e.Message.Contains("(404)")).ToList
[Error] = If(UsefulExs.Any, UsefulExs(0), ExList(0)) [Error] = If(UsefulExs.Any, UsefulExs(0), ExList(0))
'获取实际失败的文件 '获取实际失败的文件
SyncLock FilesLock For Each File In Files
For Each File In Files If File.State = NetState.Error Then
If File.State = NetState.Error Then [Error] = New Exception("文件下载失败:" & File.LocalPath & vbCrLf & Join(
[Error] = New Exception("文件下载失败:" & File.LocalPath & vbCrLf & Join( File.Sources.Select(Function(s) If(s.Ex Is Nothing, s.Url, s.Ex.Message & "(" & s.Url & ")")), vbCrLf), [Error])
File.Sources.Select(Function(s) If(s.Ex Is Nothing, s.Url, s.Ex.Message & "(" & s.Url & ")")), vbCrLf), [Error]) Exit For
Exit For End If
End If Next
Next
End SyncLock
'在设置 Error 对象后再更改为失败,避免 WaitForExit 无法捕获错误 '在设置 Error 对象后再更改为失败,避免 WaitForExit 无法捕获错误
State = LoadState.Failed State = LoadState.Failed
End SyncLock End SyncLock
'中断所有文件 '中断所有文件
SyncLock FilesLock For Each TaskFile In Files
For Each TaskFile In Files If TaskFile.State < NetState.Merge Then TaskFile.State = NetState.Error
If TaskFile.State < NetState.Merge Then TaskFile.State = NetState.Error Next
Next
End SyncLock
'在退出同步锁后再进行日志输出 '在退出同步锁后再进行日志输出
Dim ErrOutput As New List(Of String) Dim ErrOutput As New List(Of String)
For Each Ex As Exception In ExList For Each Ex As Exception In ExList
@@ -1739,11 +1773,9 @@ Retry:
End SyncLock End SyncLock
Log("[Download] " & Name & " 已取消!") Log("[Download] " & Name & " 已取消!")
'中断所有文件 '中断所有文件
SyncLock FilesLock For Each TaskFile In Files
For Each TaskFile In Files TaskFile.Abort(Me)
TaskFile.Abort(Me) Next
Next
End SyncLock
End Sub End Sub
End Class End Class
@@ -1765,8 +1797,7 @@ Retry:
''' <summary> ''' <summary>
''' 当前的所有下载任务。 ''' 当前的所有下载任务。
''' </summary> ''' </summary>
Public Tasks As New List(Of LoaderDownload) Public Tasks As New SafeList(Of LoaderDownload)
Private ReadOnly LockTasks As New Object
''' <summary> ''' <summary>
''' 已下载完成的大小。 ''' 已下载完成的大小。
@@ -1815,6 +1846,7 @@ Retry:
Private Sub RefreshStat() Private Sub RefreshStat()
Try Try
Dim DeltaTime As Long = GetTimeTick() - RefreshStatLast Dim DeltaTime As Long = GetTimeTick() - RefreshStatLast
If DeltaTime = 0 Then Return
RefreshStatLast += DeltaTime RefreshStatLast += DeltaTime
#Region "刷新整体速度" #Region "刷新整体速度"
'计算瞬时速度 '计算瞬时速度
@@ -1839,11 +1871,9 @@ Retry:
End If End If
#End Region #End Region
#Region "刷新下载任务属性" #Region "刷新下载任务属性"
SyncLock LockTasks For Each Task In Tasks
For Each Task In Tasks Task.RefreshStat()
Task.RefreshStat() Next
Next
End SyncLock
#End Region #End Region
Catch ex As Exception Catch ex As Exception
Log(ex, "刷新下载公开属性失败") Log(ex, "刷新下载公开属性失败")
@@ -1882,7 +1912,7 @@ Retry:
For Each File As NetFile In WaitingFiles For Each File As NetFile In WaitingFiles
If NetTaskThreadCount >= NetTaskThreadLimit Then Continue While '最大线程数检查 If NetTaskThreadCount >= NetTaskThreadLimit Then Continue While '最大线程数检查
Dim NewThread = File.TryBeginThread() Dim NewThread = File.TryBeginThread()
If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi.") Then Thread.Sleep(40) '减少 BMCLAPI 请求频率,避免 Too Many Requests If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi") Then Thread.Sleep(30) '减少 BMCLAPI 请求频率(目前每分钟限制 4000 次)
Next Next
'为进行中的文件追加线程 '为进行中的文件追加线程
If Speed >= NetTaskSpeedLimitLow Then Continue While '下载速度足够,无需新增 If Speed >= NetTaskSpeedLimitLow Then Continue While '下载速度足够,无需新增
@@ -1902,7 +1932,7 @@ Retry:
'新增线程 '新增线程
If PreparingCount > DownloadingCount Then Continue For '准备中的线程已多于下载中的线程,不再新增 If PreparingCount > DownloadingCount Then Continue For '准备中的线程已多于下载中的线程,不再新增
Dim NewThread = File.TryBeginThread() Dim NewThread = File.TryBeginThread()
If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi.") Then Thread.Sleep(40) '减少 BMCLAPI 请求频率,避免 Too Many Requests If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi") Then Thread.Sleep(30) '减少 BMCLAPI 请求频率(目前每分钟限制 4000 次)
Next Next
End While End While
Catch ex As Exception Catch ex As Exception
@@ -1989,9 +2019,7 @@ Retry:
Task.Files(i) = File '回设 Task.Files(i) = File '回设
Next Next
End SyncLock End SyncLock
SyncLock LockTasks Tasks.Add(Task)
Tasks.Add(Task)
End SyncLock
End Sub End Sub
End Class End Class
@@ -2000,7 +2028,7 @@ Retry:
''' 是否有正在进行中、需要在下载管理页面显示的下载任务? ''' 是否有正在进行中、需要在下载管理页面显示的下载任务?
''' </summary> ''' </summary>
Public Function HasDownloadingTask(Optional IgnoreCustomDownload As Boolean = False) As Boolean Public Function HasDownloadingTask(Optional IgnoreCustomDownload As Boolean = False) As Boolean
For Each Task In LoaderTaskbar For Each Task In LoaderTaskbar.ToList()
If (Task.Show AndAlso Task.State = LoadState.Loading) AndAlso If (Task.Show AndAlso Task.State = LoadState.Loading) AndAlso
(Not IgnoreCustomDownload OrElse Not Task.Name.ToString.Contains("自定义下载")) Then (Not IgnoreCustomDownload OrElse Not Task.Name.ToString.Contains("自定义下载")) Then
Return True Return True
@@ -1,4 +1,20 @@
'提供不同的输入验证方法,名称以 Validate 开头 '提供不同的输入验证方法,名称以 Validate 开头
Public Module ModValidate
''' <summary>
''' 进行输入验证,并返回错误原因。
''' 如果没有错误则返回空字符串。
''' </summary>
Public Function Validate(Text As String, ValidateRules As IEnumerable(Of Validate)) As String
Dim Result As String = ""
For Each ValidateRule As Validate In ValidateRules
Result = ValidateRule.Validate(Text)
If Result <> "" Then Return Result
Next
Return Result
End Function
End Module
''' <summary> ''' <summary>
''' 输入验证规则基类。要查看所有的输入验证规则,可在输入 Validate 后查看自动补全。 ''' 输入验证规则基类。要查看所有的输入验证规则,可在输入 Validate 后查看自动补全。
@@ -134,13 +150,13 @@ Public Class ValidateExcept
Public Property Excepts As ObjectModel.Collection(Of String) = New ObjectModel.Collection(Of String) Public Property Excepts As ObjectModel.Collection(Of String) = New ObjectModel.Collection(Of String)
Public Property ErrorMessage As String Public Property ErrorMessage As String
Public Sub New() Public Sub New()
ErrorMessage = "输入内容不能包含 %!" ErrorMessage = "输入内容不能包含 %"
End Sub '用于 XAML 初始化 End Sub '用于 XAML 初始化
Public Sub New(Excepts As ObjectModel.Collection(Of String), Optional ErrorMessage As String = "输入内容不能包含 %!") Public Sub New(Excepts As ObjectModel.Collection(Of String), Optional ErrorMessage As String = "输入内容不能包含 %")
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, Optional ErrorMessage As String = "输入内容不能包含 %")
Me.Excepts = New ObjectModel.Collection(Of String) Me.Excepts = New ObjectModel.Collection(Of String)
Me.ErrorMessage = ErrorMessage Me.ErrorMessage = ErrorMessage
For Each Data As String In Excepts For Each Data As String In Excepts
@@ -169,12 +185,12 @@ Public Class ValidateExceptSame
Public Property IgnoreCase As Boolean = False Public Property IgnoreCase As Boolean = False
Public Sub New() Public Sub New()
End Sub End Sub
Public Sub New(Excepts As ObjectModel.Collection(Of String), Optional ErrorMessage As String = "输入内容不能为 %!", Optional IgnoreCase As Boolean = False) Public Sub New(Excepts As ObjectModel.Collection(Of String), Optional ErrorMessage As String = "输入内容不能为 %", Optional IgnoreCase As Boolean = False)
Me.Excepts = Excepts Me.Excepts = Excepts
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, Optional ErrorMessage As String = "输入内容不能为 %", Optional IgnoreCase As Boolean = False)
Me.Excepts = New ObjectModel.Collection(Of String) Me.Excepts = New ObjectModel.Collection(Of String)
For Each Data As String In Excepts For Each Data As String In Excepts
Me.Excepts.Add(Data) Me.Excepts.Add(Data)
@@ -233,6 +249,8 @@ Public Class ValidateFolderName
'检查特殊字符串 '检查特殊字符串
Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件夹名不可为 %!", True).Validate(Str) Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件夹名不可为 %!", True).Validate(Str)
If Not InvalidStrCheck = "" Then Return InvalidStrCheck If Not InvalidStrCheck = "" Then Return InvalidStrCheck
'检查 NTFS 8.3 文件名(#4505)
If RegexCheck(Str, ".{2,}~\d") Then Return "文件夹名不能包含这一特殊格式!"
'检查文件夹重名 '检查文件夹重名
Dim Arr As New List(Of String) Dim Arr As New List(Of String)
If PathIgnore IsNot Nothing Then If PathIgnore IsNot Nothing Then
@@ -286,6 +304,8 @@ Public Class ValidateFileName
'检查特殊字符串 '检查特殊字符串
Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件名不可为 %!", True).Validate(Str) Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件名不可为 %!", True).Validate(Str)
If Not InvalidStrCheck = "" Then Return InvalidStrCheck If Not InvalidStrCheck = "" Then Return InvalidStrCheck
'检查 NTFS 8.3 文件名(#4505)
If RegexCheck(Str, ".{2,}~\d") Then Return "文件名不能包含这一特殊格式!"
'检查文件重名 '检查文件重名
If ParentFolder IsNot Nothing Then If ParentFolder IsNot Nothing Then
Dim DirInfo As New DirectoryInfo(ParentFolder) Dim DirInfo As New DirectoryInfo(ParentFolder)
@@ -351,6 +371,8 @@ Fin:
'检查特殊字符串 '检查特殊字符串
Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件夹名不可为 %!").Validate(SubStr) Dim InvalidStrCheck As String = New ValidateExceptSame({"CON", "PRN", "AUX", "CLOCK$", "NUL", "COM0", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT0", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"}, "文件夹名不可为 %!").Validate(SubStr)
If Not InvalidStrCheck = "" Then Return InvalidStrCheck If Not InvalidStrCheck = "" Then Return InvalidStrCheck
'检查 NTFS 8.3 文件名(#4505)
If RegexCheck(Str, ".{2,}~\d") Then Return "文件夹名不能包含这一特殊格式!"
Next Next
Return "" Return ""
End Function End Function
@@ -7,7 +7,7 @@ Public Class MyBitmap
''' <summary> ''' <summary>
''' 位图缓存。 ''' 位图缓存。
''' </summary> ''' </summary>
Public Shared BitmapCache As New Dictionary(Of String, MyBitmap) Public Shared BitmapCache As New Concurrent.ConcurrentDictionary(Of String, MyBitmap)
''' <summary> ''' <summary>
''' 存储的图片 ''' 存储的图片
@@ -17,15 +17,19 @@ Public Class MyBitmap
'自动类型转换 '自动类型转换
'支持的类:Image,ImageSource,Bitmap,ImageBrush,BitmapSource '支持的类:Image,ImageSource,Bitmap,ImageBrush,BitmapSource
Public Shared Widening Operator CType(Image As System.Drawing.Image) As MyBitmap Public Shared Widening Operator CType(Image As System.Drawing.Image) As MyBitmap
If Image Is Nothing Then Return Nothing
Return New MyBitmap(Image) Return New MyBitmap(Image)
End Operator End Operator
Public Shared Widening Operator CType(Image As MyBitmap) As System.Drawing.Image Public Shared Widening Operator CType(Image As MyBitmap) As System.Drawing.Image
If Image Is Nothing Then Return Nothing
Return Image.Pic Return Image.Pic
End Operator End Operator
Public Shared Widening Operator CType(Image As ImageSource) As MyBitmap Public Shared Widening Operator CType(Image As ImageSource) As MyBitmap
If Image Is Nothing Then Return Nothing
Return New MyBitmap(Image) Return New MyBitmap(Image)
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
Dim Bitmap = Image.Pic Dim Bitmap = Image.Pic
Dim rect = New System.Drawing.Rectangle(0, 0, Bitmap.Width, Bitmap.Height) Dim rect = New System.Drawing.Rectangle(0, 0, Bitmap.Width, Bitmap.Height)
Dim bitmapData = Bitmap.LockBits(rect, ImageLockMode.ReadWrite, PixelFormat.Format32bppArgb) Dim bitmapData = Bitmap.LockBits(rect, ImageLockMode.ReadWrite, PixelFormat.Format32bppArgb)
@@ -37,15 +41,19 @@ Public Class MyBitmap
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
If Image Is Nothing Then Return Nothing
Return New MyBitmap(Image) Return New MyBitmap(Image)
End Operator End Operator
Public Shared Widening Operator CType(Image As MyBitmap) As System.Drawing.Bitmap Public Shared Widening Operator CType(Image As MyBitmap) As System.Drawing.Bitmap
If Image Is Nothing Then Return Nothing
Return Image.Pic Return Image.Pic
End Operator End Operator
Public Shared Widening Operator CType(Image As ImageBrush) As MyBitmap Public Shared Widening Operator CType(Image As ImageBrush) As MyBitmap
If Image Is Nothing Then Return Nothing
Return New MyBitmap(Image) Return New MyBitmap(Image)
End Operator End Operator
Public Shared Widening Operator CType(Image As MyBitmap) As ImageBrush Public Shared Widening Operator CType(Image As MyBitmap) As ImageBrush
If Image Is Nothing Then Return Nothing
Return New ImageBrush(New MyBitmap(Image.Pic)) Return New ImageBrush(New MyBitmap(Image.Pic))
End Operator End Operator
@@ -61,23 +69,32 @@ Public Class MyBitmap
Pic = BitmapCache(FilePathOrResourceName).Pic Pic = BitmapCache(FilePathOrResourceName).Pic
Else Else
Pic = New MyBitmap(CType((New ImageSourceConverter).ConvertFromString(FilePathOrResourceName), ImageSource)) Pic = New MyBitmap(CType((New ImageSourceConverter).ConvertFromString(FilePathOrResourceName), ImageSource))
BitmapCache.Add(FilePathOrResourceName, Pic) BitmapCache.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)
Pic = New System.Drawing.Bitmap(InputStream) '判断是否为 WebP 文件头
InputStream.Dispose() Dim Header(1) As Byte
InputStream.Read(Header, 0, 2)
InputStream.Seek(0, SeekOrigin.Begin)
If Header(0) = 82 AndAlso Header(1) = 73 Then
'读取 WebP
Dim FileBytes(InputStream.Length - 1) As Byte
InputStream.Read(FileBytes, 0, FileBytes.Length)
Pic = WebPDecoder.DecodeFromBytes(FileBytes) '将代码隔离在另外一个类中,这样只要不走进这个分支就不会加载 Imazen.WebP.dll
Else
Pic = New System.Drawing.Bitmap(InputStream)
End If
End Using End Using
End If End If
Catch ex As Exception Catch ex As Exception
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)
Log(ex, $"加载位图失败({FilePathOrResourceName})") Throw New Exception($"加载 MyBitmap 失败({FilePathOrResourceName})", ex)
Throw
Else Else
Log(ex, $"指定类型有误的位图加载({FilePathOrResourceName})", LogLevel.Developer) Log(ex, $"指定类型有误的 MyBitmap 加载({FilePathOrResourceName})", LogLevel.Developer)
Exit Try Exit Try
End If End If
End Try End Try
@@ -104,6 +121,13 @@ Public Class MyBitmap
Pic = New System.Drawing.Bitmap(MS) Pic = New System.Drawing.Bitmap(MS)
End Using End Using
End Sub End Sub
Private Class WebPDecoder '将代码隔离在另外一个类中,这样只要不调用这个方法就不会加载 Imazen.WebP.dll
Public Shared Function DecodeFromBytes(Bytes As Byte()) As System.Drawing.Bitmap
If Is32BitSystem Then Throw New Exception("不支持在 32 位系统下加载 WebP 图片。")
Dim Decoder As New Imazen.WebP.SimpleDecoder()
Return Decoder.DecodeFromBytes(Bytes, Bytes.Length)
End Function
End Class
''' <summary> ''' <summary>
''' 获取裁切的图片,这个方法不会导致原对象改变且会返回一个新的对象。 ''' 获取裁切的图片,这个方法不会导致原对象改变且会返回一个新的对象。
@@ -251,7 +251,13 @@
Website = Data("links")("websiteUrl").ToString.TrimEnd("/") Website = Data("links")("websiteUrl").ToString.TrimEnd("/")
LastUpdate = Data("dateReleased") '#1194 LastUpdate = Data("dateReleased") '#1194
DownloadCount = Data("downloadCount") DownloadCount = Data("downloadCount")
If Data("logo").Count > 0 Then LogoUrl = Data("logo")("thumbnailUrl") If Data("logo").Count > 0 Then
If Data("logo")("thumbnailUrl") Is Nothing OrElse Data("logo")("thumbnailUrl") = "" Then
LogoUrl = Data("logo")("url")
Else
LogoUrl = Data("logo")("thumbnailUrl")
End If
End If
'FileIndexes / GameVersions / ModLoaders 'FileIndexes / GameVersions / ModLoaders
ModLoaders = New List(Of CompModLoaderType) ModLoaders = New List(Of CompModLoaderType)
Dim Files As New List(Of KeyValuePair(Of Integer, List(Of String))) 'FileId, GameVersions Dim Files As New List(Of KeyValuePair(Of Integer, List(Of String))) 'FileId, GameVersions
@@ -269,7 +275,7 @@
Next Next
CurseForgeFileIds = Files.Select(Function(f) f.Key).Distinct.ToList CurseForgeFileIds = Files.Select(Function(f) f.Key).Distinct.ToList
GameVersions = Files.SelectMany(Function(f) f.Value).Where(Function(v) v.StartsWithF("1.")). GameVersions = Files.SelectMany(Function(f) f.Value).Where(Function(v) v.StartsWithF("1.")).
Select(Function(v) CInt(Val(v.Split(".")(1).Before("-")))).Where(Function(v) v > 0). Select(Function(v) CInt(Val(v.Split(".")(1).BeforeFirst("-")))).Where(Function(v) v > 0).
Distinct.OrderByDescending(Function(v) v).ToList Distinct.OrderByDescending(Function(v) v).ToList
ModLoaders = ModLoaders.Distinct.OrderBy(Of Integer)(Function(t) t).ToList ModLoaders = ModLoaders.Distinct.OrderBy(Of Integer)(Function(t) t).ToList
'Type 'Type
@@ -332,6 +338,24 @@
Case 6553 : Tags.Add("写实") Case 6553 : Tags.Add("写实")
Case 6554 : Tags.Add("幻想") Case 6554 : Tags.Add("幻想")
Case 6555 : Tags.Add("原版风") Case 6555 : Tags.Add("原版风")
'资源包
Case 5244 : Tags.Add("字体包")
Case 5193 : Tags.Add("数据包")
Case 399 : Tags.Add("蒸汽朋克")
Case 396 : Tags.Add("128x")
Case 398 : Tags.Add("512x 或更高")
Case 397 : Tags.Add("256x")
Case 405 : Tags.Add("其他")
Case 395 : Tags.Add("64x")
Case 400 : Tags.Add("仿真")
Case 393 : Tags.Add("16x")
Case 403 : Tags.Add("传统")
Case 394 : Tags.Add("32x")
Case 404 : Tags.Add("动态效果")
Case 4465 : Tags.Add("模组支持")
Case 402 : Tags.Add("中世纪")
Case 401 : Tags.Add("现代")
End Select End Select
Next Next
If Not Tags.Any() Then Tags.Add("杂项") If Not Tags.Any() Then Tags.Add("杂项")
@@ -352,7 +376,7 @@
'搜索结果的键为 versions,获取特定工程的键为 game_versions '搜索结果的键为 versions,获取特定工程的键为 game_versions
GameVersions = If(CType(If(Data("game_versions"), Data("versions")), JArray), New JArray). GameVersions = If(CType(If(Data("game_versions"), Data("versions")), JArray), New JArray).
Select(Function(v) v.ToString).Where(Function(v) v.StartsWithF("1.")). Select(Function(v) v.ToString).Where(Function(v) v.StartsWithF("1.")).
Select(Of Integer)(Function(v) Val(v.Split(".")(1).Before("-"))).Where(Function(v) v > 0). Select(Of Integer)(Function(v) Val(v.Split(".")(1).BeforeFirst("-"))).Where(Function(v) v > 0).
Distinct.OrderByDescending(Function(v) v).ToList Distinct.OrderByDescending(Function(v) v).ToList
'Type 'Type
Select Case Data("project_type").ToString Select Case Data("project_type").ToString
@@ -364,6 +388,16 @@
'Tags & ModLoaders 'Tags & ModLoaders
Tags = New List(Of String) Tags = New List(Of String)
ModLoaders = New List(Of CompModLoaderType) ModLoaders = New List(Of CompModLoaderType)
If Data.ContainsKey("loaders") Then
For Each Category In Data("loaders").Select(Function(t) t.ToString)
Select Case Category
Case "forge" : ModLoaders.Add(CompModLoaderType.Forge)
Case "fabric" : ModLoaders.Add(CompModLoaderType.Fabric)
Case "quilt" : ModLoaders.Add(CompModLoaderType.Quilt)
Case "neoforge" : ModLoaders.Add(CompModLoaderType.NeoForge)
End Select
Next
End If
For Each Category In Data("categories").Select(Function(t) t.ToString) For Each Category In Data("categories").Select(Function(t) t.ToString)
Select Case Category Select Case Category
'加载器 '加载器
@@ -396,7 +430,7 @@
Case "technology" : Tags.Add("科技") Case "technology" : Tags.Add("科技")
Case "magic" : Tags.Add("魔法") Case "magic" : Tags.Add("魔法")
Case "adventure" : Tags.Add("冒险") Case "adventure" : Tags.Add("冒险")
Case "kitchen-sink" : Tags.Add("大杂烩") Case "kitchen-sink" : Tags.Add("水槽包/大杂烩")
Case "lightweight" : Tags.Add("轻量") Case "lightweight" : Tags.Add("轻量")
'光影包 '光影包
Case "cartoon" : Tags.Add("卡通") Case "cartoon" : Tags.Add("卡通")
@@ -425,6 +459,36 @@
Case "iris" : Tags.Add("Iris") Case "iris" : Tags.Add("Iris")
Case "optifine" : Tags.Add("OptiFine") Case "optifine" : Tags.Add("OptiFine")
Case "vanilla" : Tags.Add("原版光影") Case "vanilla" : Tags.Add("原版光影")
'资源包
Case "8x-" : Tags.Add("8x-")
Case "16x" : Tags.Add("16x")
Case "32x" : Tags.Add("32x")
Case "48x" : Tags.Add("48x")
Case "64x" : Tags.Add("64x")
Case "128x" : Tags.Add("128x")
Case "256x" : Tags.Add("256x")
Case "512x+" : Tags.Add("512x+")
Case "audio" : Tags.Add("声音")
Case "blocks" : Tags.Add("方块")
Case "combat" : Tags.Add("战斗")
Case "core-shaders" : Tags.Add("核心着色器")
Case "cursed" : Tags.Add("Cursed")
Case "decoration" : Tags.Add("装饰")
Case "entities" : Tags.Add("实体")
Case "environment" : Tags.Add("环境")
Case "equipment" : Tags.Add("装备")
Case "fonts" : Tags.Add("字体")
Case "gui" : Tags.Add("GUI")
Case "items" : Tags.Add("物品")
Case "locale" : Tags.Add("本地化")
Case "modded" : Tags.Add("Modded")
Case "models" : Tags.Add("模型")
Case "realistic" : Tags.Add("写实")
Case "simplistic" : Tags.Add("扁平")
Case "themed" : Tags.Add("主题")
Case "tweaks" : Tags.Add("优化")
Case "utility" : Tags.Add("实用")
Case "vanilla-like" : Tags.Add("类原生")
End Select End Select
Next Next
If Not Tags.Any() Then Tags.Add("杂项") If Not Tags.Any() Then Tags.Add("杂项")
@@ -453,7 +517,7 @@
Json("DownloadCount") = DownloadCount Json("DownloadCount") = DownloadCount
If ModLoaders IsNot Nothing AndAlso ModLoaders.Any Then Json("ModLoaders") = New JArray(ModLoaders.Select(Function(m) CInt(m))) If ModLoaders IsNot Nothing AndAlso ModLoaders.Any Then Json("ModLoaders") = New JArray(ModLoaders.Select(Function(m) CInt(m)))
Json("Tags") = New JArray(Tags) Json("Tags") = New JArray(Tags)
If LogoUrl IsNot Nothing Then Json("LogoUrl") = LogoUrl If Not String.IsNullOrEmpty(LogoUrl) Then Json("LogoUrl") = LogoUrl
If GameVersions.Any Then Json("GameVersions") = New JArray(GameVersions) If GameVersions.Any Then Json("GameVersions") = New JArray(GameVersions)
Json("CacheTime") = Date.Now '用于检查缓存时间 Json("CacheTime") = Date.Now '用于检查缓存时间
Return Json Return Json
@@ -465,7 +529,7 @@
'获取版本描述 '获取版本描述
Dim GameVersionDescription As String Dim GameVersionDescription As String
If GameVersions Is Nothing OrElse Not GameVersions.Any() Then If GameVersions Is Nothing OrElse Not GameVersions.Any() Then
GameVersionDescription = "未知" GameVersionDescription = "仅快照版本" '#5412
Else Else
Dim SpaVersions As New List(Of String) Dim SpaVersions As New List(Of String)
Dim IsOld As Boolean = False Dim IsOld As Boolean = False
@@ -488,14 +552,14 @@
If StartVersion = EndVersion Then If StartVersion = EndVersion Then
SpaVersions.Add("1." & StartVersion) SpaVersions.Add("1." & StartVersion)
ElseIf McVersionHighest > -1 AndAlso StartVersion >= McVersionHighest Then ElseIf McVersionHighest > -1 AndAlso StartVersion >= McVersionHighest Then
If EndVersion <= 10 Then If EndVersion < 10 Then
SpaVersions.Clear() SpaVersions.Clear()
SpaVersions.Add("全版本") SpaVersions.Add("全版本")
Exit For Exit For
Else Else
SpaVersions.Add("1." & EndVersion & "+") SpaVersions.Add("1." & EndVersion & "+")
End If End If
ElseIf EndVersion <= 10 Then ElseIf EndVersion < 10 Then
SpaVersions.Add("1." & StartVersion & "-") SpaVersions.Add("1." & StartVersion & "-")
Exit For Exit For
ElseIf StartVersion - EndVersion = 1 Then ElseIf StartVersion - EndVersion = 1 Then
@@ -508,25 +572,32 @@
End If End If
'获取 Mod 加载器描述 '获取 Mod 加载器描述
Dim ModLoaderDescriptionFull As String, ModLoaderDescriptionPart As String Dim ModLoaderDescriptionFull As String, ModLoaderDescriptionPart As String
Select Case ModLoaders.Count Dim ModLoadersForDesc As New List(Of CompModLoaderType)(ModLoaders)
If Setup.Get("ToolDownloadIgnoreQuilt") Then ModLoadersForDesc.Remove(CompModLoaderType.Quilt)
Select Case ModLoadersForDesc.Count
Case 0 Case 0
ModLoaderDescriptionFull = "未知" If ModLoaders.Count = 1 Then
ModLoaderDescriptionPart = "" ModLoaderDescriptionFull = "仅 " & ModLoaders.Single.ToString
ModLoaderDescriptionPart = ModLoaders.Single.ToString
Else
ModLoaderDescriptionFull = "未知"
ModLoaderDescriptionPart = ""
End If
Case 1 Case 1
ModLoaderDescriptionFull = "仅 " & ModLoaders.Single.ToString ModLoaderDescriptionFull = "仅 " & ModLoadersForDesc.Single.ToString
ModLoaderDescriptionPart = ModLoaders.Single.ToString ModLoaderDescriptionPart = ModLoadersForDesc.Single.ToString
Case 2, 3 Case Else
If Setup.Get("ToolDownloadIgnoreQuilt") AndAlso Dim MaxVersion As Integer = If(GameVersions.Any, GameVersions.Max, 99)
ModLoaders.Contains(CompModLoaderType.Forge) AndAlso ModLoaders.Contains(CompModLoaderType.Fabric) Then If ModLoaders.Contains(CompModLoaderType.Forge) AndAlso
(MaxVersion < 14 OrElse ModLoaders.Contains(CompModLoaderType.Fabric)) AndAlso
(MaxVersion < 20 OrElse ModLoaders.Contains(CompModLoaderType.NeoForge)) AndAlso
(MaxVersion < 14 OrElse ModLoaders.Contains(CompModLoaderType.Quilt) OrElse Setup.Get("ToolDownloadIgnoreQuilt")) Then
ModLoaderDescriptionFull = "任意" ModLoaderDescriptionFull = "任意"
ModLoaderDescriptionPart = "" ModLoaderDescriptionPart = ""
Else Else
ModLoaderDescriptionFull = ModLoaders.Join(" / ") ModLoaderDescriptionFull = ModLoadersForDesc.Join(" / ")
ModLoaderDescriptionPart = ModLoaders.Join(" / ") ModLoaderDescriptionPart = ModLoadersForDesc.Join(" / ")
End If End If
Case Else
ModLoaderDescriptionFull = "任意"
ModLoaderDescriptionPart = ""
End Select End Select
'实例化 UI '实例化 UI
Dim NewItem As New MyCompItem With {.Tag = Me, .Logo = GetControlLogo()} Dim NewItem As New MyCompItem With {.Tag = Me, .Logo = GetControlLogo()}
@@ -572,7 +643,7 @@
Return NewItem Return NewItem
End Function End Function
Public Function GetControlLogo() As String Public Function GetControlLogo() As String
If LogoUrl Is Nothing Then If String.IsNullOrEmpty(LogoUrl) Then
Return PathImage & "Icons/NoIcon.png" Return PathImage & "Icons/NoIcon.png"
Else Else
Return LogoUrl Return LogoUrl
@@ -613,9 +684,9 @@
'有中文翻译 '有中文翻译
'尝试将文本分为三段:Title (EnglishName) - Suffix '尝试将文本分为三段:Title (EnglishName) - Suffix
'检查时注意 Carpet:它没有中文译名,但有 Suffix '检查时注意 Carpet:它没有中文译名,但有 Suffix
Title = TranslatedName.Before(" (").Before(" - ") Title = TranslatedName.BeforeFirst(" (").BeforeFirst(" - ")
Dim Suffix As String = "" Dim Suffix As String = ""
If TranslatedName.After(")").Contains(" - ") Then Suffix = TranslatedName.After(")").After(" - ") If TranslatedName.AfterLast(")").Contains(" - ") Then Suffix = TranslatedName.AfterLast(")").AfterLast(" - ")
Dim EnglishName As String = TranslatedName Dim EnglishName As String = TranslatedName
If Suffix <> "" Then EnglishName = EnglishName.Replace(" - " & Suffix, "") If Suffix <> "" Then EnglishName = EnglishName.Replace(" - " & Suffix, "")
EnglishName = EnglishName.Replace(Title, "").Trim("("c, ")"c, " "c) EnglishName = EnglishName.Replace(Title, "").Trim("("c, ")"c, " "c)
@@ -679,6 +750,9 @@ NoSubtitle:
If ModLoaders.Count <> Project.ModLoaders.Count OrElse ModLoaders.Except(Project.ModLoaders).Any() Then Return False If ModLoaders.Count <> Project.ModLoaders.Count OrElse ModLoaders.Except(Project.ModLoaders).Any() Then Return False
'MC 版本一致 'MC 版本一致
If GameVersions.Count <> Project.GameVersions.Count OrElse GameVersions.Except(Project.GameVersions).Any() Then Return False If GameVersions.Count <> Project.GameVersions.Count OrElse GameVersions.Except(Project.GameVersions).Any() Then Return False
'最近更新时间差距在一周以内
If LastUpdate IsNot Nothing AndAlso Project.LastUpdate IsNot Nothing AndAlso
Math.Abs((LastUpdate - Project.LastUpdate).Value.TotalDays) > 7 Then Return False
'MCMOD 翻译名 / 原名 / 描述文本 / Slug 的英文部分相同 'MCMOD 翻译名 / 原名 / 描述文本 / Slug 的英文部分相同
If TranslatedName = Project.TranslatedName OrElse If TranslatedName = Project.TranslatedName OrElse
RawName = Project.RawName OrElse Description = Project.Description OrElse RawName = Project.RawName OrElse Description = Project.Description OrElse
@@ -787,8 +861,10 @@ NoSubtitle:
Address += "&classId=4471" Address += "&classId=4471"
Case CompType.Shader Case CompType.Shader
Address += "&classId=6552" Address += "&classId=6552"
Case CompType.ResourcePack
Address += "&classId=12"
End Select End Select
Address += "&categoryId=" & If(Tag = "", "0", Tag.Before("/")) Address += "&categoryId=" & If(Tag = "", "0", Tag.BeforeFirst("/"))
If ModLoader <> CompModLoaderType.Any Then Address += "&modLoaderType=" & CType(ModLoader, Integer) If ModLoader <> CompModLoaderType.Any Then Address += "&modLoaderType=" & CType(ModLoader, Integer)
If Not String.IsNullOrEmpty(GameVersion) Then Address += "&gameVersion=" & GameVersion If Not String.IsNullOrEmpty(GameVersion) Then Address += "&gameVersion=" & GameVersion
If Not String.IsNullOrEmpty(SearchText) Then Address += "&searchFilter=" & Net.WebUtility.UrlEncode(SearchText) If Not String.IsNullOrEmpty(SearchText) Then Address += "&searchFilter=" & Net.WebUtility.UrlEncode(SearchText)
@@ -809,7 +885,7 @@ NoSubtitle:
'facets=[["categories:'game-mechanics'"],["categories:'forge'"],["versions:1.19.3"],["project_type:mod"]] 'facets=[["categories:'game-mechanics'"],["categories:'forge'"],["versions:1.19.3"],["project_type:mod"]]
Dim Facets As New List(Of String) Dim Facets As New List(Of String)
Facets.Add($"[""project_type:{GetStringFromEnum(Type).ToLower}""]") Facets.Add($"[""project_type:{GetStringFromEnum(Type).ToLower}""]")
If Not String.IsNullOrEmpty(Tag) Then Facets.Add($"[""categories:'{Tag.After("/")}'""]") If Not String.IsNullOrEmpty(Tag) Then Facets.Add($"[""categories:'{Tag.AfterLast("/")}'""]")
If ModLoader <> CompModLoaderType.Any Then Facets.Add($"[""categories:'{GetStringFromEnum(ModLoader).ToLower}'""]") If ModLoader <> CompModLoaderType.Any Then Facets.Add($"[""categories:'{GetStringFromEnum(ModLoader).ToLower}'""]")
If Not String.IsNullOrEmpty(GameVersion) Then Facets.Add($"[""versions:'{GameVersion}'""]") If Not String.IsNullOrEmpty(GameVersion) Then Facets.Add($"[""versions:'{GameVersion}'""]")
Address += "&facets=[" & String.Join(",", Facets) & "]" Address += "&facets=[" & String.Join(",", Facets) & "]"
@@ -917,7 +993,7 @@ NoSubtitle:
If Not SearchResults(i).AbsoluteRight AndAlso i >= Math.Min(2, SearchResults.Count - 1) Then Exit For '把 3 个结果拼合以提高准确度 If Not SearchResults(i).AbsoluteRight AndAlso i >= Math.Min(2, SearchResults.Count - 1) Then Exit For '把 3 个结果拼合以提高准确度
If SearchResults(i).Item.CurseForgeSlug IsNot Nothing Then SearchResult += SearchResults(i).Item.CurseForgeSlug.Replace("-", " ").Replace("/", " ") & " " If SearchResults(i).Item.CurseForgeSlug IsNot Nothing Then SearchResult += SearchResults(i).Item.CurseForgeSlug.Replace("-", " ").Replace("/", " ") & " "
If SearchResults(i).Item.ModrinthSlug IsNot Nothing Then SearchResult += SearchResults(i).Item.ModrinthSlug.Replace("-", " ").Replace("/", " ") & " " If SearchResults(i).Item.ModrinthSlug IsNot Nothing Then SearchResult += SearchResults(i).Item.ModrinthSlug.Replace("-", " ").Replace("/", " ") & " "
SearchResult += SearchResults(i).Item.ChineseName.After(" (").TrimEnd(") ").Before(" - "). SearchResult += SearchResults(i).Item.ChineseName.AfterLast(" (").TrimEnd(") ").BeforeFirst(" - ").
Replace(":", "").Replace("(", "").Replace(")", "").ToLower.Replace("/", " ") & " " Replace(":", "").Replace("(", "").Replace(")", "").ToLower.Replace("/", " ") & " "
Next Next
Log("[Comp] 中文搜索原始关键词:" & SearchResult, LogLevel.Developer) Log("[Comp] 中文搜索原始关键词:" & SearchResult, LogLevel.Developer)
@@ -933,7 +1009,7 @@ NoSubtitle:
End If End If
'驼峰英文请求关键字处理 '驼峰英文请求关键字处理
Dim SpacedKeywords = RegexReplace(Task.Input.SearchText, "$& ", "([A-Z]+|[a-z]+?)(?=[A-Z]+[a-z]+[a-z ]*)") Dim SpacedKeywords = Task.Input.SearchText.RegexReplace("([A-Z]+|[a-z]+?)(?=[A-Z]+[a-z]+[a-z ]*)", "$& ")
Dim ConnectedKeywords = Task.Input.SearchText.Replace(" ", "") Dim ConnectedKeywords = Task.Input.SearchText.Replace(" ", "")
Dim AllPossibleKeywords = (SpacedKeywords & " " & If(IsChineseSearch, Task.Input.SearchText, ConnectedKeywords & " " & RawFilter)).ToLower Dim AllPossibleKeywords = (SpacedKeywords & " " & If(IsChineseSearch, Task.Input.SearchText, ConnectedKeywords & " " & RawFilter)).ToLower
@@ -980,30 +1056,30 @@ Retry:
Dim CurseForgeFailed As Boolean = False Dim CurseForgeFailed As Boolean = False
If CurseForgeUrl IsNot Nothing Then If CurseForgeUrl IsNot Nothing Then
CurseForgeThread = RunInNewThread( CurseForgeThread = RunInNewThread(
Sub() Sub()
Try Try
'获取工程列表 '获取工程列表
Log("[Comp] 开始从 CurseForge 获取工程列表:" & CurseForgeUrl) Log("[Comp] 开始从 CurseForge 获取工程列表:" & CurseForgeUrl)
Dim RequestResult As JObject = DlModRequest(CurseForgeUrl, IsJson:=True) Dim RequestResult As JObject = DlModRequest(CurseForgeUrl, IsJson:=True)
Task.Progress += 0.2 Task.Progress += 0.2
Dim ProjectList As New List(Of CompProject) Dim ProjectList As New List(Of CompProject)
For Each JsonEntry As JObject In RequestResult("data") For Each JsonEntry As JObject In RequestResult("data")
ProjectList.Add(New CompProject(JsonEntry)) ProjectList.Add(New CompProject(JsonEntry))
Next Next
'更新结果 '更新结果
SyncLock ResultsLock SyncLock ResultsLock
RawResults.AddRange(ProjectList) RawResults.AddRange(ProjectList)
End SyncLock End SyncLock
Storage.CurseForgeOffset += ProjectList.Count Storage.CurseForgeOffset += ProjectList.Count
Storage.CurseForgeTotal = RequestResult("pagination")("totalCount").ToObject(Of Integer) Storage.CurseForgeTotal = RequestResult("pagination")("totalCount").ToObject(Of Integer)
Log($"[Comp] 从 CurseForge 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.CurseForgeOffset} 个,共 {Storage.CurseForgeTotal} 个)") Log($"[Comp] 从 CurseForge 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.CurseForgeOffset} 个,共 {Storage.CurseForgeTotal} 个)")
Catch ex As Exception Catch ex As Exception
Log(ex, "从 CurseForge 获取工程列表失败") Log(ex, "从 CurseForge 获取工程列表失败")
Storage.CurseForgeTotal = -1 'Storage.CurseForgeOffset Storage.CurseForgeTotal = -1 'Storage.CurseForgeOffset
[Error] = ex [Error] = ex
CurseForgeFailed = True CurseForgeFailed = True
End Try End Try
End Sub, "CurseForge Project Request") End Sub, "CurseForge Project Request")
End If End If
'启动 Modrinth 线程 '启动 Modrinth 线程
@@ -1011,32 +1087,32 @@ Retry:
Dim ModrinthFailed As Boolean = False Dim ModrinthFailed As Boolean = False
If ModrinthUrl IsNot Nothing Then If ModrinthUrl IsNot Nothing Then
ModrinthThread = RunInNewThread( ModrinthThread = RunInNewThread(
Sub() Sub()
Try Try
Log("[Comp] 开始从 Modrinth 获取工程列表:" & ModrinthUrl) Log("[Comp] 开始从 Modrinth 获取工程列表:" & ModrinthUrl)
Dim RequestResult As JObject = DlModRequest(ModrinthUrl, IsJson:=True) Dim RequestResult As JObject = DlModRequest(ModrinthUrl, IsJson:=True)
Task.Progress += 0.2 Task.Progress += 0.2
Dim ProjectList As New List(Of CompProject) Dim ProjectList As New List(Of CompProject)
For Each JsonEntry As JObject In RequestResult("hits") For Each JsonEntry As JObject In RequestResult("hits")
ProjectList.Add(New CompProject(JsonEntry)) ProjectList.Add(New CompProject(JsonEntry))
Next
'更新结果
SyncLock ResultsLock
For Each Project In ProjectList
If Task.Input.Type = CompType.Mod AndAlso Not Project.ModLoaders.Any() Then Continue For '过滤插件(#2458)
RawResults.Add(Project)
Next Next
'更新结果 End SyncLock
SyncLock ResultsLock Storage.ModrinthOffset += ProjectList.Count
For Each Project In ProjectList Storage.ModrinthTotal = RequestResult("total_hits").ToObject(Of Integer)
If Task.Input.Type = CompType.Mod AndAlso Not Project.ModLoaders.Any() Then Continue For '过滤插件(#2458) Log($"[Comp] 从 Modrinth 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.ModrinthOffset} 个,共 {Storage.ModrinthTotal} 个)")
RawResults.Add(Project) Catch ex As Exception
Next Log(ex, "从 Modrinth 获取工程列表失败")
End SyncLock Storage.ModrinthTotal = -1 'Storage.ModrinthOffset
Storage.ModrinthOffset += ProjectList.Count [Error] = ex
Storage.ModrinthTotal = RequestResult("total_hits").ToObject(Of Integer) ModrinthFailed = True
Log($"[Comp] 从 Modrinth 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.ModrinthOffset} 个,共 {Storage.ModrinthTotal} 个)") End Try
Catch ex As Exception End Sub, "Modrinth Project Request")
Log(ex, "从 Modrinth 获取工程列表失败")
Storage.ModrinthTotal = -1 'Storage.ModrinthOffset
[Error] = ex
ModrinthFailed = True
End Try
End Sub, "Modrinth Project Request")
End If End If
'等待线程结束 '等待线程结束
@@ -1080,7 +1156,7 @@ Retry:
#Region "提取非重复项,存储于 RealResults" #Region "提取非重复项,存储于 RealResults"
'将 Modrinth 排在 CurseForge 的前面,避免加载结束顺序不同导致排名不同 '将 Modrinth 排在 CurseForge 的前面,避免加载结束顺序不同导致排名不同
'这样做的话,去重后将优先保留 CurseForge 内容(考虑到 CurseForge 热度更高) '这样做的话,去重后将优先保留 CurseForge 内容
RawResults = RawResults.Where(Function(x) Not x.FromCurseForge).Concat(RawResults.Where(Function(x) x.FromCurseForge)).ToList RawResults = RawResults.Where(Function(x) Not x.FromCurseForge).Concat(RawResults.Where(Function(x) x.FromCurseForge)).ToList
'RawResults 去重 'RawResults 去重
RawResults = RawResults.Distinct(Function(a, b) a.IsLike(b)) RawResults = RawResults.Distinct(Function(a, b) a.IsLike(b))
@@ -1097,7 +1173,7 @@ Retry:
If RealResults.Count + Storage.Results.Count < Task.Input.TargetResultCount Then If RealResults.Count + Storage.Results.Count < Task.Input.TargetResultCount Then
Log($"[Comp] 总结果数需求最少 {Task.Input.TargetResultCount} 个,仅获得了 {RealResults.Count + Storage.Results.Count} 个") Log($"[Comp] 总结果数需求最少 {Task.Input.TargetResultCount} 个,仅获得了 {RealResults.Count + Storage.Results.Count} 个")
If Task.Input.CanContinue Then If Task.Input.CanContinue AndAlso [Error] Is Nothing Then '如果有下载源失败则不再重试,这时候重试可能导致无限循环
Log("[Comp] 将继续尝试加载下一页") Log("[Comp] 将继续尝试加载下一页")
GoTo Retry GoTo Retry
Else Else
@@ -1113,7 +1189,7 @@ Retry:
If String.IsNullOrEmpty(Task.Input.SearchText) Then If String.IsNullOrEmpty(Task.Input.SearchText) Then
'如果没有搜索文本,按下载量将结果排序 '如果没有搜索文本,按下载量将结果排序
For Each Result As CompProject In RealResults For Each Result As CompProject In RealResults
Scores.Add(Result, Result.DownloadCount * If(Result.FromCurseForge, 1, 10)) Scores.Add(Result, Result.DownloadCount * If(Result.FromCurseForge, 1, 5))
Next Next
Else Else
'如果有搜索文本,按关联度将结果排序 '如果有搜索文本,按关联度将结果排序
@@ -1121,7 +1197,7 @@ Retry:
Dim Entry As New List(Of SearchEntry(Of CompProject)) Dim Entry As New List(Of SearchEntry(Of CompProject))
For Each Result As CompProject In RealResults For Each Result As CompProject In RealResults
Scores.Add(Result, If(Result.WikiId > 0, 0.2, 0) + Scores.Add(Result, If(Result.WikiId > 0, 0.2, 0) +
Math.Log10(Math.Max(Result.DownloadCount, 1) * If(Result.FromCurseForge, 1, 10)) / 9) Math.Log10(Math.Max(Result.DownloadCount, 1) * If(Result.FromCurseForge, 1, 5)) / 9)
Entry.Add(New SearchEntry(Of CompProject) With {.Item = Result, .SearchSource = New List(Of KeyValuePair(Of String, Double)) From { Entry.Add(New SearchEntry(Of CompProject) With {.Item = Result, .SearchSource = New List(Of KeyValuePair(Of String, Double)) From {
New KeyValuePair(Of String, Double)(If(IsChineseSearch, Result.TranslatedName, Result.RawName), 1), New KeyValuePair(Of String, Double)(If(IsChineseSearch, Result.TranslatedName, Result.RawName), 1),
New KeyValuePair(Of String, Double)(Result.Description, 0.05)}}) New KeyValuePair(Of String, Double)(Result.Description, 0.05)}})
@@ -1133,7 +1209,7 @@ Retry:
End If End If
'根据排序分得出结果并添加 '根据排序分得出结果并添加
Storage.Results.AddRange( Storage.Results.AddRange(
Sort(Scores.ToList, Function(a, b) a.Value > b.Value).Select(Function(r) r.Key).ToList) Scores.OrderByDescending(Function(s) s.Value).Select(Function(r) r.Key))
#End Region #End Region
@@ -1186,7 +1262,7 @@ Retry:
''' </summary> ''' </summary>
Public ReadOnly ModLoaders As List(Of CompModLoaderType) Public ReadOnly ModLoaders As List(Of CompModLoaderType)
''' <summary> ''' <summary>
''' 支持的游戏版本列表。类型包括:"1.18.5","1.18","1.18 快照","21w15a","未知版本"。 ''' 支持的游戏版本列表。类型包括:"1.18.5","1.18","1.18 预览版","21w15a","未知版本"。
''' </summary> ''' </summary>
Public ReadOnly GameVersions As List(Of String) Public ReadOnly GameVersions As List(Of String)
''' <summary> ''' <summary>
@@ -1287,10 +1363,7 @@ Retry:
Dim Url = Data("downloadUrl").ToString Dim Url = Data("downloadUrl").ToString
If Url = "" Then Url = $"https://media.forgecdn.net/files/{CInt(Id.ToString.Substring(0, 4))}/{CInt(Id.ToString.Substring(4))}/{FileName}" If Url = "" Then Url = $"https://media.forgecdn.net/files/{CInt(Id.ToString.Substring(0, 4))}/{CInt(Id.ToString.Substring(4))}/{FileName}"
Url = Url.Replace(FileName, Net.WebUtility.UrlEncode(FileName)) '对文件名进行编码 Url = Url.Replace(FileName, Net.WebUtility.UrlEncode(FileName)) '对文件名进行编码
DownloadUrls = (New List(Of String) From {Url.Replace("-service.overwolf.wtf", ".forgecdn.net").Replace("://edge", "://media"), DownloadUrls = HandleCurseForgeDownloadUrls(Url) '对脑残 CurseForge 的下载地址进行多种修正
Url.Replace("-service.overwolf.wtf", ".forgecdn.net"),
Url.Replace("://edge", "://media"),
Url}).Distinct.ToList '对脑残 CurseForge 的下载地址进行多种修正
DownloadUrls.AddRange(DownloadUrls.Select(Function(u) DlSourceModGet(u)).ToList) '添加镜像源,这个写法是为了让镜像源排在后面 DownloadUrls.AddRange(DownloadUrls.Select(Function(u) DlSourceModGet(u)).ToList) '添加镜像源,这个写法是为了让镜像源排在后面
DownloadUrls = DownloadUrls.Distinct.ToList '最终去重 DownloadUrls = DownloadUrls.Distinct.ToList '最终去重
'Dependencies 'Dependencies
@@ -1302,9 +1375,9 @@ Retry:
End If End If
'GameVersions 'GameVersions
Dim RawVersions As List(Of String) = Data("gameVersions").Select(Function(t) t.ToString.Trim.ToLower).ToList Dim RawVersions As List(Of String) = Data("gameVersions").Select(Function(t) t.ToString.Trim.ToLower).ToList
GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.")).Select(Function(v) v.Replace("-snapshot", " 快照")).ToList GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.")).Select(Function(v) v.Replace("-snapshot", " 预览版")).ToList
If GameVersions.Count > 1 Then If GameVersions.Count > 1 Then
GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList GameVersions = GameVersions.Sort(AddressOf VersionSortBoolean).ToList
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)} If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)}
ElseIf GameVersions.Count = 1 Then ElseIf GameVersions.Count = 1 Then
GameVersions = GameVersions.ToList GameVersions = GameVersions.ToList
@@ -1343,9 +1416,9 @@ Retry:
'GameVersions 'GameVersions
Dim RawVersions As List(Of String) = Data("game_versions").Select(Function(t) t.ToString.Trim.ToLower).ToList Dim RawVersions As List(Of String) = Data("game_versions").Select(Function(t) t.ToString.Trim.ToLower).ToList
GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.") OrElse v.StartsWithF("b1.")). GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.") OrElse v.StartsWithF("b1.")).
Select(Function(v) If(v.Contains("-"), v.Before("-") & " 快照", If(v.StartsWithF("b1."), "远古版本", v))).ToList Select(Function(v) If(v.Contains("-"), v.BeforeFirst("-") & " 预览版", If(v.StartsWithF("b1."), "远古版本", v))).ToList
If GameVersions.Count > 1 Then If GameVersions.Count > 1 Then
GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList GameVersions = GameVersions.Sort(AddressOf VersionSortBoolean).ToList
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)} If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)}
ElseIf GameVersions.Count = 1 Then ElseIf GameVersions.Count = 1 Then
'无需处理 '无需处理
@@ -1365,6 +1438,19 @@ Retry:
End If End If
End If End If
End Sub End Sub
''' <summary>
''' 重新整理 CurseForge 的下载地址。
''' </summary>
Public Shared Function HandleCurseForgeDownloadUrls(Url As String) As List(Of String)
Return {
Url.Replace("-service.overwolf.wtf", ".forgecdn.net").Replace("://edge", "://media"),
Url.Replace("-service.overwolf.wtf", ".forgecdn.net"),
Url.Replace("://edge", "://media"),
Url
}.Distinct.ToList
End Function
''' <summary> ''' <summary>
''' 将当前实例转为可用于保存缓存的 Json。 ''' 将当前实例转为可用于保存缓存的 Json。
''' </summary> ''' </summary>
@@ -1392,28 +1478,26 @@ Retry:
Optional BadDisplayName As Boolean = False) As MyListItem Optional BadDisplayName As Boolean = False) As MyListItem
'获取描述信息 '获取描述信息
Dim Info As String = "" Dim Title As String = If(BadDisplayName, FileName, DisplayName)
Dim Info As New List(Of String)
If Title <> FileName.BeforeLast(".") Then Info.Add(FileName.BeforeLast("."))
Select Case Type Select Case Type
Case CompType.Mod Case CompType.Mod
Info += If(ModLoaders.Any, If Dependencies.Any Then Info.Add(Dependencies.Count & " 个前置 Mod")
"适用于 " & Join(ModLoaders.Select(Function(m) GetStringFromEnum(m)).ToList, "/") & ",", "")
Info += If(ModeDebug AndAlso Dependencies.Any, Dependencies.Count & " 个前置 Mod,", "")
Case CompType.ModPack Case CompType.ModPack
If GameVersions.All(Function(v) v.Contains("w")) Then If GameVersions.All(Function(v) v.Contains("w")) Then Info.Add($"游戏版本 {Join(GameVersions, "、")}")
Info += $"游戏版本 {Join(GameVersions, "、")},"
End If
End Select End Select
If DownloadCount > 0 Then 'CurseForge 的下载次数经常错误地返回 0 If DownloadCount > 0 Then 'CurseForge 的下载次数经常错误地返回 0
Info += If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次下载,", DownloadCount & " 次下载,") Info.Add("下载 " & If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次", DownloadCount & " 次"))
End If End If
Info += GetTimeSpanString(ReleaseDate - Date.Now, False) & "更新" Info.Add("更新于 " & GetTimeSpanString(ReleaseDate - Date.Now, False))
Info += If(Status = CompFileStatus.Release, "", "," & StatusDescription) If Status <> CompFileStatus.Release Then Info.Add(StatusDescription)
'建立控件 '建立控件
Dim NewItem As New MyListItem With { Dim NewItem As New MyListItem With {
.Title = If(BadDisplayName, FileName, DisplayName), .Title = Title,
.SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Me, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Me,
.Info = Info .Info = Info.Join(",")
} }
Select Case Status Select Case Status
Case CompFileStatus.Release Case CompFileStatus.Release
@@ -1452,14 +1536,12 @@ Retry:
''' <summary> ''' <summary>
''' 已知文件信息的缓存。 ''' 已知文件信息的缓存。
''' </summary> ''' </summary>
Private CompFilesCache As New Dictionary(Of String, List(Of CompFile)) Public CompFilesCache As New Dictionary(Of String, List(Of CompFile))
''' <summary> ''' <summary>
''' 获取某个工程下的全部文件列表。 ''' 获取某个工程下的全部文件列表。
''' 必须在工作线程执行,失败会抛出异常。 ''' 必须在工作线程执行,失败会抛出异常。
''' </summary> ''' </summary>
Public Function CompFilesGet(ProjectId As String, FromCurseForge As Boolean) As List(Of CompFile) Public Function CompFilesGet(ProjectId As String, FromCurseForge As Boolean) As List(Of CompFile)
'使用缓存
If CompFilesCache.ContainsKey(ProjectId) Then Return CompFilesCache(ProjectId)
'获取工程对象 '获取工程对象
Dim TargetProject As CompProject Dim TargetProject As CompProject
If CompProjectCache.ContainsKey(ProjectId) Then '存在缓存 If CompProjectCache.ContainsKey(ProjectId) Then '存在缓存
@@ -1470,25 +1552,29 @@ Retry:
TargetProject = New CompProject(DlModRequest("https://api.modrinth.com/v2/project/" & ProjectId, IsJson:=True)) TargetProject = New CompProject(DlModRequest("https://api.modrinth.com/v2/project/" & ProjectId, IsJson:=True))
End If End If
'获取工程对象的文件列表 '获取工程对象的文件列表
Log("[Comp] 开始获取文件列表:" & ProjectId) If Not CompFilesCache.ContainsKey(ProjectId) Then '有缓存也不能直接返回,这时候前置 Mod 可能没获取(#5173)
Dim ResultJsonArray As JArray Log("[Comp] 开始获取文件列表:" & ProjectId)
If FromCurseForge Then Dim ResultJsonArray As JArray
'CurseForge If FromCurseForge Then
If TargetProject.Type = CompType.Mod Then 'Mod 使用每个版本最新的文件 'CurseForge
ResultJsonArray = GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(TargetProject.CurseForgeFileIds, ",") & "]}", "application/json"))("data") 'HMCL 一次性请求了 10000 个文件,虽然不知道会不会出问题但先这样吧……(#5522)
Else '否则使用全部文件 ResultJsonArray = DlModRequest($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=10000", IsJson:=True)("data")
ResultJsonArray = DlModRequest($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=999", IsJson:=True)("data") '之前只请求一部分文件的方法备份如下:
'If TargetProject.Type = CompType.Mod Then 'Mod 使用每个版本最新的文件
' ResultJsonArray = GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(TargetProject.CurseForgeFileIds, ",") & "]}", "application/json"))("data")
'Else '否则使用全部文件
' ResultJsonArray = DlModRequest($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=999", IsJson:=True)("data")
'End If
Else
'Modrinth
ResultJsonArray = DlModRequest($"https://api.modrinth.com/v2/project/{ProjectId}/version", IsJson:=True)
End If End If
Else CompFilesCache(ProjectId) = ResultJsonArray.Select(Function(a) New CompFile(a, TargetProject.Type)).
'Modrinth Where(Function(a) a.Available).ToList.Distinct(Function(a, b) a.Id = b.Id) 'CurseForge 可能会重复返回相同项(#1330)
ResultJsonArray = DlModRequest($"https://api.modrinth.com/v2/project/{ProjectId}/version", IsJson:=True)
End If End If
CompFilesCache(ProjectId) = ResultJsonArray.Select(Function(a) New CompFile(a, TargetProject.Type)).
Where(Function(a) a.Available).ToList.Distinct(Function(a, b) a.Id = b.Id) 'CurseForge 可能会重复返回相同项(#1330)
'获取前置 Mod 列表 '获取前置 Mod 列表
If TargetProject.Type <> CompType.Mod Then Return CompFilesCache(ProjectId) If TargetProject.Type <> CompType.Mod Then Return CompFilesCache(ProjectId)
Dim Deps As List(Of String) = CompFilesCache(ProjectId). Dim Deps As List(Of String) = CompFilesCache(ProjectId).SelectMany(Function(f) f.RawDependencies).Distinct().ToList
SelectMany(Function(f) f.RawDependencies).Distinct().ToList
Dim UndoneDeps = Deps.Where(Function(f) Not CompProjectCache.ContainsKey(f)).ToList Dim UndoneDeps = Deps.Where(Function(f) Not CompProjectCache.ContainsKey(f)).ToList
'获取前置 Mod 工程信息 '获取前置 Mod 工程信息
If UndoneDeps.Any Then If UndoneDeps.Any Then
@@ -1506,10 +1592,10 @@ Retry:
End If End If
'更新前置 Mod 信息 '更新前置 Mod 信息
If Deps.Any Then If Deps.Any Then
For Each DepProject In Deps.Select(Function(id) CompProjectCache(id)) For Each DepProject In Deps.Where(Function(id) CompProjectCache.ContainsKey(id)).Select(Function(id) CompProjectCache(id))
For Each File In CompFilesCache(ProjectId) For Each File In CompFilesCache(ProjectId)
If File.RawDependencies.Contains(DepProject.Id) AndAlso DepProject.Id <> ProjectId Then If File.RawDependencies.Contains(DepProject.Id) AndAlso DepProject.Id <> ProjectId Then
File.Dependencies.Add(DepProject.Id) If Not File.Dependencies.Contains(DepProject.Id) Then File.Dependencies.Add(DepProject.Id)
End If End If
Next Next
Next Next
@@ -1526,10 +1612,11 @@ Retry:
Dim Deps As List(Of String) = Files.SelectMany(Function(f) f.Dependencies).Distinct.ToList() Dim Deps As List(Of String) = Files.SelectMany(Function(f) f.Dependencies).Distinct.ToList()
Deps.Sort() Deps.Sort()
If Not Deps.Any() Then Exit Sub If Not Deps.Any() Then Exit Sub
Deps = Deps.Where(Function(dep) Deps = Deps.Where(
If Not CompProjectCache.ContainsKey(dep) Then Log($"[Comp] 未找到 ID {dep} 的前置 Mod 信息", LogLevel.Debug) Function(dep)
Return CompProjectCache.ContainsKey(dep) If Not CompProjectCache.ContainsKey(dep) Then Log($"[Comp] 未找到 ID {dep} 的前置 Mod 信息", LogLevel.Debug)
End Function).ToList Return CompProjectCache.ContainsKey(dep)
End Function).ToList
'添加开头间隔 '添加开头间隔
Stack.Children.Add(New TextBlock With {.Text = "前置 Mod", .FontSize = 14, .HorizontalAlignment = HorizontalAlignment.Left, .Margin = New Thickness(6, 2, 0, 5)}) Stack.Children.Add(New TextBlock With {.Text = "前置 Mod", .FontSize = 14, .HorizontalAlignment = HorizontalAlignment.Left, .Margin = New Thickness(6, 2, 0, 5)})
'添加前置 Mod 列表 '添加前置 Mod 列表
@@ -1,24 +1,10 @@
Public Class CrashAnalyzer Public Class CrashAnalyzer
Private Shared IsAnalyzeCacheCleared As Boolean = False
Private Shared IsAnalyzeCacheClearedLock As New Object
'构造函数 '构造函数
Private TempFolder As String Private TempFolder As String
Public Sub New(UUID As Integer) Public Sub New(UUID As Integer)
'清理缓存
SyncLock IsAnalyzeCacheClearedLock
If Not IsAnalyzeCacheCleared Then
Try
DeleteDirectory(PathTemp & "CrashAnalyzer\")
Catch ex As Exception
Log(ex, "清理崩溃分析缓存失败")
End Try
IsAnalyzeCacheCleared = True
End If
End SyncLock
'构建文件结构 '构建文件结构
TempFolder = PathTemp & "CrashAnalyzer\" & UUID & RandomInteger(0, 99999999) & "\" TempFolder = RequestTaskTempFolder()
DeleteDirectory(TempFolder)
Directory.CreateDirectory(TempFolder & "Temp\") Directory.CreateDirectory(TempFolder & "Temp\")
Directory.CreateDirectory(TempFolder & "Report\") Directory.CreateDirectory(TempFolder & "Report\")
Log("[Crash] 崩溃分析暂存文件夹:" & TempFolder) Log("[Crash] 崩溃分析暂存文件夹:" & TempFolder)
@@ -381,6 +367,7 @@ Extracted:
没有可用的分析文件 没有可用的分析文件
使用32位Java导致JVM无法分配足够多的内存 使用32位Java导致JVM无法分配足够多的内存
Mod重复安装 Mod重复安装
Mod互不兼容
OptiFine与Forge不兼容 OptiFine与Forge不兼容
Fabric报错 Fabric报错
Fabric报错并给出解决方案 Fabric报错并给出解决方案
@@ -389,7 +376,7 @@ Extracted:
版本Json中存在多个Forge 版本Json中存在多个Forge
Mod过多导致超出ID限制 Mod过多导致超出ID限制
NightConfig的Bug NightConfig的Bug
ShadersMod与Optifine同时安装 ShadersMod与OptiFine同时安装
Forge安装不完整 Forge安装不完整
Mod需要Java11 Mod需要Java11
Mod缺少前置或MC版本错误 Mod缺少前置或MC版本错误
@@ -413,7 +400,7 @@ Extracted:
'崩溃日志 '崩溃日志
If LogCrash IsNot Nothing Then If LogCrash IsNot Nothing Then
Log("[Crash] 开始进行崩溃日志堆栈分析") Log("[Crash] 开始进行崩溃日志堆栈分析")
Keywords.AddRange(AnalyzeStackKeyword(LogCrash.Before("System Details"))) Keywords.AddRange(AnalyzeStackKeyword(LogCrash.BeforeFirst("System Details")))
End If End If
'Minecraft 日志 'Minecraft 日志
If LogMc IsNot Nothing Then If LogMc IsNot Nothing Then
@@ -516,7 +503,7 @@ Done:
If LogMc.Contains("java.lang.ClassNotFoundException: org.spongepowered.asm.launch.MixinTweaker") Then AppendReason(CrashReason.MixinBootstrap缺失) If LogMc.Contains("java.lang.ClassNotFoundException: org.spongepowered.asm.launch.MixinTweaker") Then AppendReason(CrashReason.MixinBootstrap缺失)
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") 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))
@@ -525,6 +512,7 @@ Done:
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") 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 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名称包含特殊字符)
If LogMc.Contains("has been compiled by a more recent version of the Java Runtime (class file version 55.0), this version of the Java Runtime only recognizes class file versions up to") Then AppendReason(CrashReason.Mod需要Java11) If LogMc.Contains("has been compiled by a more recent version of the Java Runtime (class file version 55.0), this version of the Java Runtime only recognizes class file versions up to") Then AppendReason(CrashReason.Mod需要Java11)
If LogMc.Contains("java.lang.RuntimeException: java.lang.NoSuchMethodException: no such method: sun.misc.Unsafe.defineAnonymousClass(Class,byte[],Object[])Class/invokeVirtual") Then AppendReason(CrashReason.Mod需要Java11) If LogMc.Contains("java.lang.RuntimeException: java.lang.NoSuchMethodException: no such method: sun.misc.Unsafe.defineAnonymousClass(Class,byte[],Object[])Class/invokeVirtual") Then AppendReason(CrashReason.Mod需要Java11)
@@ -540,12 +528,14 @@ Done:
End If End If
'确定的 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]{1}:[^\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))
'Mod 缺少前置 If LogMc.Contains("Incompatible mods found!") Then '#5006
AppendReason(CrashReason.Mod互不兼容, If(RegexSeek(LogMc, "(?<=Incompatible mods found![\s\S]+: )[\s\S]+?(?=\tat )"), ""))
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版本错误,
RegexSearch(LogMc, "(?<=Missing or unsupported mandatory dependencies:)([\n\r]+\t(.*))+", RegularExpressions.RegexOptions.IgnoreCase). RegexSearch(LogMc, "(?<=Missing or unsupported mandatory dependencies:)([\n\r]+\t(.*))+", RegularExpressions.RegexOptions.IgnoreCase).
@@ -573,8 +563,9 @@ Done:
If LogCrash.Contains("has mods that were not found") AndAlso RegexCheck(LogCrash, "The Mod File [^\n]+optifine\\OptiFine[^\n]+ has mods that were not found") Then AppendReason(CrashReason.OptiFine与Forge不兼容) If LogCrash.Contains("has mods that were not found") AndAlso RegexCheck(LogCrash, "The Mod File [^\n]+optifine\\OptiFine[^\n]+ has mods that were not found") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
'Mod 导致的崩溃 'Mod 导致的崩溃
If LogCrash.Contains("-- MOD ") Then If LogCrash.Contains("-- MOD ") Then
If LogCrash.Between("-- MOD ", "Failure message:").ContainsF(".jar", True) Then Dim LogCrashMod As String = LogCrash.Between("-- MOD ", "Failure message:")
AppendReason(CrashReason.确定Mod导致游戏崩溃, If(RegexSeek(LogCrash, "(?<=Mod File: ).+"), "").TrimEnd((vbCrLf & " ").ToCharArray)) If LogCrashMod.ContainsF(".jar", True) Then
AppendReason(CrashReason.确定Mod导致游戏崩溃, If(RegexSeek(LogCrashMod, "(?<=Mod File: ).+"), "").TrimEnd((vbCrLf & " ").ToCharArray))
Else Else
AppendReason(CrashReason.Mod加载器报错, If(RegexSeek(LogCrash, "(?<=Failure message: )[\w\W]+?(?=\tMod)"), "").Replace(vbTab, " ").TrimEnd((vbCrLf & " ").ToCharArray)) AppendReason(CrashReason.Mod加载器报错, If(RegexSeek(LogCrash, "(?<=Failure message: )[\w\W]+?(?=\tMod)"), "").Replace(vbTab, " ").TrimEnd((vbCrLf & " ").ToCharArray))
End If End If
@@ -591,40 +582,57 @@ Done:
''' </summary> ''' </summary>
Private Sub AnalyzeCrit2() Private Sub AnalyzeCrit2()
'Mixin 分析
Dim MixinAnalyze =
Function(LogText As String) As Boolean
Dim IsMixin As Boolean =
LogText.Contains("Mixin prepare failed ") OrElse LogText.Contains("Mixin apply failed ") OrElse
LogText.Contains("MixinApplyError") OrElse LogText.Contains("MixinTransformerError") OrElse
LogText.Contains("mixin.injection.throwables.") OrElse LogText.Contains(".json] FAILED during )")
If Not IsMixin Then Return False
'Mod 名称匹配
Dim ModName As String = RegexSeek(LogText, "(?<=from mod )[^.\/ ]+(?=\] from)")
If ModName Is Nothing Then ModName = RegexSeek(LogText, "(?<=for mod )[^.\/ ]+(?= failed)")
If ModName IsNot Nothing Then
AppendReason(CrashReason.ModMixin失败, TryAnalyzeModName(ModName.TrimEnd((vbCrLf & " ").ToCharArray)))
Return True
End If
'JSON 名称匹配
For Each JsonName In RegexSearch(LogText, "(?<=^[^\t]+[ \[{(]{1})[^ \[{(]+\.[^ ]+(?=\.json)", RegularExpressions.RegexOptions.Multiline)
AppendReason(CrashReason.ModMixin失败,
TryAnalyzeModName(JsonName.Replace("mixins", "mixin").Replace(".mixin", "").Replace("mixin.", "")))
Return True
Next
'没有明确匹配
AppendReason(CrashReason.ModMixin失败)
Return True
End Function
'游戏日志分析 '游戏日志分析
If LogMc IsNot Nothing Then If LogMc IsNot Nothing Then
'Mixin 崩溃
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)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf)) If LogMc.Contains("A potential solution has been determined:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf))
If LogMc.Contains("A potential solution has been determined, this may resolve your problem:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined, this may resolve your problem:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf)) If LogMc.Contains("A potential solution has been determined, this may resolve your problem:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined, this may resolve your problem:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf))
If LogMc.Contains("确定了一种可能的解决方法,这样做可能会解决你的问题:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=确定了一种可能的解决方法,这样做可能会解决你的问题:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf)) If LogMc.Contains("确定了一种可能的解决方法,这样做可能会解决你的问题:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=确定了一种可能的解决方法,这样做可能会解决你的问题:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf))
'Mixin 崩溃 If Not IsMixin AndAlso LogMc.Contains("due to errors, provided by ") Then '在 #3104 的情况下,这一句导致 OptiFabric 的 Mixin 失败错判为 Fabric Loader 加载失败
If LogMc.Contains("Mixin prepare failed ") OrElse LogMc.Contains("Mixin apply failed ") OrElse LogMc.Contains("MixinApplyError") OrElse AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=due to errors, provided by ')[^']+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
LogMc.Contains("mixin.injection.throwables.") OrElse LogMc.Contains(".json] FAILED during )") Then
Dim ModId As String = RegexSeek(LogMc, "(?<=in )[^./ ]+(?=.mixins.json.+failed injection check)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=in mixins.)[^./ ]+(?=.json.+failed injection check)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= failed .+ in )[^./ ]+(?=.mixins.json)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= failed .+ in mixins.)[^./ ]+(?=.json)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= failed mixins.)[^./ ]+(?=.json:)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= in config \[)[^./ ]+(?=.mixins.json\] FAILED during )")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= in config \[mixins.)[^./ ]+(?=.json\] FAILED during )")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=from mod )[^./ ]+(?=\] from)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=for mod )[^./ ]+(?= failed)")
'兜底名称判断
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "[^./ \]]+(?=.mixins.json)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=mixins.)[^./ \]]+(?=.json)")
AppendReason(CrashReason.ModMixin失败, TryAnalyzeModName(If(ModId, "").TrimEnd((vbCrLf & " ").ToCharArray)))
Else
'在 #3104 的情况下,这一句导致 OptiFabric 的 Mixin 失败错判为 Fabric Loader 加载失败
If LogMc.Contains("due to errors, provided by ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=due to errors, provided by ')[^']+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
End If End If
End If End If
'崩溃报告分析 '崩溃报告分析
If LogCrash IsNot Nothing Then If LogCrash IsNot Nothing Then
'Mixin 崩溃
MixinAnalyze(LogCrash)
'常规信息
If LogCrash.Contains("Suspected Mod") Then If LogCrash.Contains("Suspected Mod") Then
Dim Suspects = RegexSearch(LogCrash.Between("Suspected Mod", "Stacktrace"), "(?<=\n\t[^(\t]+\()[^)\n]+") Dim SuspectsRaw As String = LogCrash.Between("Suspected Mod", "Stacktrace")
If Suspects.Any Then AppendReason(CrashReason.怀疑Mod导致游戏崩溃, TryAnalyzeModName(Suspects)) If Not SuspectsRaw.StartsWithF("s: None") Then 'Suspected Mods: None
Dim Suspects = RegexSearch(SuspectsRaw, "(?<=\n\t[^(\t]+\()[^)\n]+")
If Suspects.Any Then AppendReason(CrashReason.怀疑Mod导致游戏崩溃, TryAnalyzeModName(Suspects))
End If
End If End If
End If End If
@@ -640,6 +648,8 @@ Done:
If Not (LogMc.Contains("at net.") OrElse LogMc.Contains("INFO]")) AndAlso LogHs Is Nothing AndAlso LogCrash Is Nothing AndAlso LogMc.Length < 100 Then If Not (LogMc.Contains("at net.") OrElse LogMc.Contains("INFO]")) AndAlso LogHs Is Nothing AndAlso LogCrash Is Nothing AndAlso LogMc.Length < 100 Then
AppendReason(CrashReason.极短的程序输出, LogMc) AppendReason(CrashReason.极短的程序输出, LogMc)
End If End If
'Mod 解析错误(常见于 Fabric 前置校验失败)
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! 不一定是崩溃原因,它可能是单纯的警报
@@ -695,7 +705,7 @@ NextStack:
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", "oshi", "impl", "data", "pool", "task",
"forge", "setup", "block", "model", "mixin", "event", "unimi", "netty", "world", "forge", "setup", "block", "model", "mixin", "event", "unimi", "netty", "world",
"gitlab", "common", "server", "config", "loader", "launch", "entity", "assist", "client", "plugin", "modapi", "mojang", "shader", "events", "github", "recipe", "render", "packet", "events", "gitlab", "common", "server", "config", "mixins", "compat", "loader", "launch", "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",
"fastutil", "optifine", "internal", "platform", "override", "fabricmc", "neoforge", "fastutil", "optifine", "internal", "platform", "override", "fabricmc", "neoforge",
"injection", "listeners", "scheduler", "minecraft", "transformer", "transformers", "neoforged", "universal", "multipart", "minecraftforge", "blockentity", "spongepowered", "electronwill" "injection", "listeners", "scheduler", "minecraft", "transformer", "transformers", "neoforged", "universal", "multipart", "minecraftforge", "blockentity", "spongepowered", "electronwill"
@@ -738,13 +748,13 @@ NextStack:
Details = Details.Replace("Fabric Mods", "¨") Details = Details.Replace("Fabric Mods", "¨")
Log("[Crash] 崩溃报告中检测到 Fabric Mod 信息格式") Log("[Crash] 崩溃报告中检测到 Fabric Mod 信息格式")
End If End If
Details = Details.After("¨") Details = Details.AfterLast("¨")
'[Forge] 获取所有包含 .jar 的行 '[Forge] 获取所有包含 .jar 的行
'[Fabric] 获取所有包含 Mod 信息的行 '[Fabric] 获取所有包含 Mod 信息的行
Dim ModNameLines As New List(Of String) Dim ModNameLines As New List(Of String)
For Each Line In Details.Split(vbLf) For Each Line In Details.Split(vbLf)
If Line.ContainsF(".jar", True) OrElse If (Line.ContainsF(".jar", True) AndAlso Line.Length - Line.Replace(".jar", "").Length = 4) OrElse '只有一个 .jar
(IsFabricDetail AndAlso Line.StartsWithF(vbTab & vbTab) AndAlso Not RegexCheck(Line, "\t\tfabric[\w-]*: Fabric")) Then ModNameLines.Add(Line) (IsFabricDetail AndAlso Line.StartsWithF(vbTab & vbTab) AndAlso Not RegexCheck(Line, "\t\tfabric[\w-]*: Fabric")) Then ModNameLines.Add(Line)
Next Next
Log("[Crash] 崩溃报告中找到 " & ModNameLines.Count & " 个可能的 Mod 项目行") Log("[Crash] 崩溃报告中找到 " & ModNameLines.Count & " 个可能的 Mod 项目行")
@@ -848,21 +858,25 @@ NextStack:
"确定", If(IsHandAnalyze OrElse DirectFile Is Nothing, "", "查看日志"), If(IsHandAnalyze, "", "导出错误报告"), "确定", If(IsHandAnalyze OrElse DirectFile Is Nothing, "", "查看日志"), If(IsHandAnalyze, "", "导出错误报告"),
Button2Action:=If(IsHandAnalyze OrElse DirectFile Is Nothing, Nothing, Button2Action:=If(IsHandAnalyze OrElse DirectFile Is Nothing, Nothing,
Sub() Sub()
Try
'弹窗选择:查看日志 '弹窗选择:查看日志
If File.Exists(DirectFile.Value.Key) Then If File.Exists(DirectFile.Value.Key) Then
ShellOnly("notepad", DirectFile.Value.Key) ShellOnly(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, Join(DirectFile.Value.Value, vbCrLf))
ShellOnly(FilePath) ShellOnly(FilePath)
End If End If
Catch ex As Exception
Log(ex,"尝试打开文件失败",LogLevel.Hint)
End Try
End Sub)) End Sub))
Case 3 Case 3
'弹窗选择:导出错误报告 '弹窗选择:导出错误报告
Dim FileAddress As String = Nothing Dim FileAddress As String = Nothing
Try Try
'获取文件路径 '获取文件路径
RunInUiWait(Sub() FileAddress = SelectAs("选择保存位置", "错误报告-" & Date.Now.ToString("G").Replace("/", "-").Replace(":", ".").Replace(" ", "_") & ".zip", "Minecraft 错误报告(*.zip)|*.zip")) RunInUiWait(Sub() FileAddress = SelectSaveFile("选择保存位置", "错误报告-" & Date.Now.ToString("G").Replace("/", "-").Replace(":", ".").Replace(" ", "_") & ".zip", "Minecraft 错误报告(*.zip)|*.zip"))
If String.IsNullOrEmpty(FileAddress) Then Exit Sub If String.IsNullOrEmpty(FileAddress) Then Exit Sub
Directory.CreateDirectory(GetPathFromFullPath(FileAddress)) Directory.CreateDirectory(GetPathFromFullPath(FileAddress))
If File.Exists(FileAddress) Then File.Delete(FileAddress) If File.Exists(FileAddress) Then File.Delete(FileAddress)
@@ -873,19 +887,23 @@ NextStack:
If ExtraFiles IsNot Nothing Then OutputFiles.AddRange(ExtraFiles) If ExtraFiles IsNot Nothing Then OutputFiles.AddRange(ExtraFiles)
For Each OutputFile In OutputFiles For Each OutputFile In OutputFiles
Dim FileName As String = GetFileNameFromPath(OutputFile) Dim FileName As String = GetFileNameFromPath(OutputFile)
Dim FileEncoding As Encoding = Nothing
Select Case FileName Select Case FileName
Case "LatestLaunch.bat" Case "LatestLaunch.bat"
FileName = "启动脚本.bat" FileName = "启动脚本.bat"
Case "Log1.txt" Case "Log1.txt"
FileName = "PCL 启动器日志.txt" FileName = "PCL 启动器日志.txt"
FileEncoding = Encoding.UTF8
Case "RawOutput.log" Case "RawOutput.log"
FileName = "游戏崩溃前的输出.txt" FileName = "游戏崩溃前的输出.txt"
FileEncoding = Encoding.UTF8
End Select End Select
If File.Exists(OutputFile) Then If File.Exists(OutputFile) Then
Dim FileEncoding As Encoding = GetEncoding(ReadFileBytes(OutputFile)) If FileEncoding Is Nothing Then FileEncoding = GetEncoding(ReadFileBytes(OutputFile))
WriteFile(TempFolder & "Report\" & FileName, WriteFile(TempFolder & "Report\" & FileName,
SecretFilter(ReadFile(OutputFile, FileEncoding), If(FileName = "启动脚本.bat", "F", "*")), SecretFilter(ReadFile(OutputFile, FileEncoding), If(FileName = "启动脚本.bat", "F", "*")),
Encoding:=FileEncoding) Encoding:=FileEncoding)
Log($"[Crash] 导出文件:{FileName},编码:{FileEncoding.HeaderName}")
End If End If
Next Next
'导出报告 '导出报告
@@ -896,7 +914,7 @@ NextStack:
Log(ex, "导出错误报告失败", LogLevel.Feedback) Log(ex, "导出错误报告失败", LogLevel.Feedback)
Exit Sub Exit Sub
End Try End Try
OpenExplorer("/select,""" & FileAddress & """") OpenExplorer(FileAddress)
End Select End Select
End Sub End Sub
''' <summary> ''' <summary>
@@ -909,7 +927,7 @@ NextStack:
If IsHandAnalyze Then If IsHandAnalyze Then
Return "很抱歉,PCL 无法确定错误原因。" Return "很抱歉,PCL 无法确定错误原因。"
Else Else
Return $"很抱歉,你的游戏出现了一些问题……{vbCrLf}如果要寻求帮助,请导出错误报告并发给他人,而不是发送这个窗口的截图。" Return $"很抱歉,你的游戏出现了一些问题……{vbCrLf}如果要寻求帮助,请把错误报告文件发给对方,而不是发送这个窗口的照片或者截图。"
End If End If
End If End If
@@ -942,9 +960,9 @@ 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 - " & Join(Additional, "\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.Count = 1 Then
@@ -965,7 +983,9 @@ NextStack:
Results.Add("以下 Mod 导致了游戏出错:\n - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h") Results.Add("以下 Mod 导致了游戏出错:\n - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
End If End If
Case CrashReason.ModMixin失败 Case CrashReason.ModMixin失败
If Additional.Count = 1 Then If Additional.Count = 0 Then
Results.Add("部分 Mod 注入失败,导致游戏出错。\n这一般代表着部分 Mod 与其他 Mod 或当前环境不兼容,或是它存在 Bug。\n你可以尝试逐步禁用 Mod,然后观察游戏是否还会崩溃,以此定位导致崩溃的 Mod。\n\e\h")
ElseIf Additional.Count = 1 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 - " & Join(Additional, "\n - ") & "\n这一般代表着它们与其他 Mod 或当前环境不兼容,或是它存在 Bug。\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
@@ -980,7 +1000,7 @@ NextStack:
If Additional.Count = 1 Then If Additional.Count = 1 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 - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
End If End If
Case CrashReason.特定方块导致崩溃 Case CrashReason.特定方块导致崩溃
If Additional.Count = 1 Then If Additional.Count = 1 Then
@@ -992,7 +1012,7 @@ NextStack:
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 - " & Join(Additional, "\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.Count = 1 Then
@@ -1002,12 +1022,12 @@ NextStack:
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 版本,并严格按照对应版本重新安装游戏。")
Case CrashReason.ShadersMod与Optifine同时安装 Case CrashReason.ShadersMod与OptiFine同时安装
Results.Add("无需同时安装 Optifine 和 Shaders Mod,Optifine 已经集成了 Shaders Mod 的功能。\n在删除 Shaders Mod 后,游戏即可正常运行。") Results.Add("无需同时安装 Optifine 和 Shaders Mod,OptiFine 已经集成了 Shaders Mod 的功能。\n在删除 Shaders Mod 后,游戏即可正常运行。")
Case CrashReason.低版本Forge与高版本Java不兼容 Case CrashReason.低版本Forge与高版本Java不兼容
Results.Add("由于低版本 Forge 与当前 Java 不兼容,导致了游戏崩溃。\n\n请尝试以下解决方案:\n - 更新 Forge 到 36.2.26 或更高版本\n - 换用版本低于 1.8.0.320 的 Java") Results.Add("由于低版本 Forge 与当前 Java 不兼容,导致了游戏崩溃。\n\n请尝试以下解决方案:\n - 更新 Forge 到 36.2.26 或更高版本\n - 换用版本低于 1.8.0.320 的 Java")
Case CrashReason.版本Json中存在多个Forge Case CrashReason.版本Json中存在多个Forge
Results.Add("可能由于使用其他启动器修改了 Forge 版本,当前版本的文件存在异常,导致了游戏崩溃。\n请尝试重新全新安装 Forge,而非使用其他启动器修改 Forge 版本。") Results.Add("可能由于其他启动器修改了 Forge 版本,当前版本的文件存在异常,导致了游戏崩溃。\n请尝试重新全新安装 Forge,而非使用其他启动器修改 Forge 版本。")
Case CrashReason.玩家手动触发调试崩溃 Case CrashReason.玩家手动触发调试崩溃
Results.Add("* 事实上,你的游戏没有任何问题,这是你自己触发的崩溃。\n* 你难道没有更重要的事要做吗?") Results.Add("* 事实上,你的游戏没有任何问题,这是你自己触发的崩溃。\n* 你难道没有更重要的事要做吗?")
Case CrashReason.Mod需要Java11 Case CrashReason.Mod需要Java11
@@ -1033,30 +1053,36 @@ NextStack:
Case CrashReason.文件或内容校验失败 Case CrashReason.文件或内容校验失败
Results.Add("部分文件或内容校验失败,导致游戏出现了问题。\n\n请尝试删除游戏(包括 Mod)并重新下载,或尝试在重新下载时使用 VPN。\h") Results.Add("部分文件或内容校验失败,导致游戏出现了问题。\n\n请尝试删除游戏(包括 Mod)并重新下载,或尝试在重新下载时使用 VPN。\h")
Case CrashReason.Forge安装不完整 Case CrashReason.Forge安装不完整
Results.Add("由于 Forge 安装不完整,导致游戏无法正常运行。\n请尝试重新安装 Forge。\h") Results.Add("由于安装的 Forge 文件丢失,导致游戏无法正常运行。\n请重新安装一次相同版本的 Forge,然后再启动游戏。\n在打包游戏时删除 libraries 文件夹可能导致此错误。\h")
Case CrashReason.Fabric报错 Case CrashReason.Fabric报错
If Additional.Count = 1 Then If Additional.Count = 1 Then
Results.Add("Fabric 提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。") Results.Add("Fabric 提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
Else Else
Results.Add("Fabric 可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息,可以查看错误报告了解错误具体是如何发生的。\h") Results.Add("Fabric 可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
End If
Case CrashReason.Mod互不兼容
If Additional.Count = 1 Then
Results.Add("你所安装的 Mod 不兼容:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
Else
Results.Add("你所安装的 Mod 不兼容,Mod 加载器可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
End If End If
Case CrashReason.Mod加载器报错 Case CrashReason.Mod加载器报错
If Additional.Count = 1 Then If Additional.Count = 1 Then
Results.Add("Mod 加载器提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。") Results.Add("Mod 加载器提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
Else Else
Results.Add("Mod 加载器可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息,可以查看错误报告了解错误具体是如何发生的。\h") Results.Add("Mod 加载器可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
End If End If
Case CrashReason.Fabric报错并给出解决方案 Case CrashReason.Fabric报错并给出解决方案
If Additional.Count = 1 Then If Additional.Count = 1 Then
Results.Add("Fabric 提供了以下解决方案:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。") Results.Add("Fabric 提供了以下解决方案:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
Else Else
Results.Add("Fabric 可能已经提供了解决方案,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息,可以查看错误报告了解错误具体是如何发生的。\h") Results.Add("Fabric 可能已经提供了解决方案,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
End If End If
Case CrashReason.Forge报错 Case CrashReason.Forge报错
If Additional.Count = 1 Then If Additional.Count = 1 Then
Results.Add("Forge 提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。") Results.Add("Forge 提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
Else Else
Results.Add("Forge 可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息,可以查看错误报告了解错误具体是如何发生的。\h") Results.Add("Forge 可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
End If End If
Case CrashReason.没有可用的分析文件 Case CrashReason.没有可用的分析文件
Results.Add("你的游戏出现了一些问题,但 PCL 未能找到相关记录文件,因此无法进行分析。\h") Results.Add("你的游戏出现了一些问题,但 PCL 未能找到相关记录文件,因此无法进行分析。\h")
@@ -1072,7 +1098,7 @@ NextStack:
Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, vbCrLf). Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, vbCrLf).
Trim(vbCrLf.ToCharArray) & Trim(vbCrLf.ToCharArray) &
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
@@ -21,12 +21,7 @@
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(Version.JsonObject("downloads")("client")("size"), -1), Hash:=Version.JsonObject("downloads")("client")("sha1"))
If ReturnNothingOnFileUseable Then If ReturnNothingOnFileUseable AndAlso Checker.Check(Version.Path & Version.Name & ".jar") Is Nothing Then Return Nothing '通过校验
'是否跳过
Dim IsSetupSkip As Boolean = ShouldIgnoreFileCheck(Version)
If IsSetupSkip AndAlso File.Exists(Version.Path & Version.Name & ".jar") Then Return Nothing '跳过校验
If Checker.Check(Version.Path & Version.Name & ".jar") Is Nothing Then Return Nothing '通过校验
End If
'返回下载信息 '返回下载信息
Dim JarUrl As String = Version.JsonObject("downloads")("client")("url") Dim JarUrl As String = Version.JsonObject("downloads")("client")("url")
Return New NetFile(DlSourceLauncherOrMetaGet(JarUrl), Version.Path & Version.Name & ".jar", Checker) Return New NetFile(DlSourceLauncherOrMetaGet(JarUrl), Version.Path & Version.Name & ".jar", Checker)
@@ -56,7 +51,7 @@
''' <summary> ''' <summary>
''' 构造补全某 Minecraft 版本的所有文件的加载器列表。失败会抛出异常。 ''' 构造补全某 Minecraft 版本的所有文件的加载器列表。失败会抛出异常。
''' </summary> ''' </summary>
Public Function DlClientFix(Version As McVersion, CheckAssetsHash As Boolean, AssetsIndexBehaviour As AssetsIndexExistsBehaviour, SkipAssetsDownloadWhileSetupRequired As Boolean) As List(Of LoaderBase) Public Function DlClientFix(Version As McVersion, 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 "下载支持库文件"
@@ -69,9 +64,9 @@
#End Region #End Region
#Region "下载资源文件" #Region "下载资源文件"
Dim IsSetupSkip As Boolean = ShouldIgnoreFileCheck(Version) If ShouldIgnoreFileCheck(Version) Then
If IsSetupSkip Then Log("[Download] 已跳过 Assets 下载") Log("[Download] 已跳过所有 Assets 检查")
If (Not SkipAssetsDownloadWhileSetupRequired) OrElse Not IsSetupSkip Then Else
Dim LoadersAssets As New List(Of LoaderBase) Dim LoadersAssets As New List(Of LoaderBase)
'获取资源文件索引地址 '获取资源文件索引地址
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析资源文件索引地址", LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析资源文件索引地址",
@@ -104,7 +99,7 @@
Task.Output = New List(Of NetFile) From {BackAssetsFile} Task.Output = New List(Of NetFile) From {BackAssetsFile}
'检查是否需要更新:每天只更新一次 '检查是否需要更新:每天只更新一次
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.Abort()
End If End If
End Sub)) End Sub))
@@ -121,7 +116,7 @@
'获取资源文件地址 '获取资源文件地址
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)))
Task.Output = McAssetsFixList(McAssetsGetIndexName(Version), CheckAssetsHash, Task) Task.Output = McAssetsFixList(Version, CheckAssetsHash, Task)
End Sub) With {.ProgressWeight = 3}) 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})
@@ -172,24 +167,25 @@
End Structure End Structure
''' <summary> ''' <summary>
''' Minecraft 客户端 版本列表,主加载器。 ''' Minecraft 客户端 版本列表,主加载器。
''' 若要求镜像源必须包含某个版本,则将该版本 ID 作为输入(#5195)。
''' </summary> ''' </summary>
Public DlClientListLoader As New LoaderTask(Of Integer, DlClientListResult)("DlClientList Main", AddressOf DlClientListMain) Public DlClientListLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Main", AddressOf DlClientListMain)
Private Sub DlClientListMain(Loader As LoaderTask(Of Integer, DlClientListResult)) Private Sub DlClientListMain(Loader As LoaderTask(Of String, DlClientListResult))
Select Case Setup.Get("ToolDownloadVersion") Select Case Setup.Get("ToolDownloadVersion")
Case 0 Case 0
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)) From { DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListBmclapiLoader, 30), New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListBmclapiLoader, 30),
New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListMojangLoader, 60) New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListMojangLoader, 30 + 60)
}, Loader.IsForceRestarting) }, Loader.IsForceRestarting)
Case 1 Case 1
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)) From { DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListMojangLoader, 5), New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListMojangLoader, 5),
New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListBmclapiLoader, 35) New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListBmclapiLoader, 5 + 30)
}, Loader.IsForceRestarting) }, Loader.IsForceRestarting)
Case Else Case Else
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)) From { DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)) From {
New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListMojangLoader, 60), New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListMojangLoader, 60),
New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListBmclapiLoader, 60) New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListBmclapiLoader, 60 + 60)
}, Loader.IsForceRestarting) }, Loader.IsForceRestarting)
End Select End Select
End Sub End Sub
@@ -198,9 +194,9 @@
''' <summary> ''' <summary>
''' Minecraft 客户端 版本列表,Mojang 官方源加载器。 ''' Minecraft 客户端 版本列表,Mojang 官方源加载器。
''' </summary> ''' </summary>
Public DlClientListMojangLoader As New LoaderTask(Of Integer, DlClientListResult)("DlClientList Mojang", AddressOf DlClientListMojangMain) Public DlClientListMojangLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Mojang", AddressOf DlClientListMojangMain)
Private IsNewClientVersionHinted As Boolean = False Private IsNewClientVersionHinted As Boolean = False
Private Sub DlClientListMojangMain(Loader As LoaderTask(Of Integer, DlClientListResult)) Private Sub DlClientListMojangMain(Loader As LoaderTask(Of String, DlClientListResult))
Dim Json As JObject = NetGetCodeByRequestRetry("https://launchermeta.mojang.com/mc/game/version_manifest.json", IsJson:=True) Dim Json As JObject = NetGetCodeByRequestRetry("https://launchermeta.mojang.com/mc/game/version_manifest.json", IsJson:=True)
Try Try
Dim Versions As JArray = Json("versions") Dim Versions As JArray = Json("versions")
@@ -230,14 +226,21 @@
''' <summary> ''' <summary>
''' Minecraft 客户端 版本列表,BMCLAPI 源加载器。 ''' Minecraft 客户端 版本列表,BMCLAPI 源加载器。
''' </summary> ''' </summary>
Public DlClientListBmclapiLoader As New LoaderTask(Of Integer, DlClientListResult)("DlClientList Bmclapi", AddressOf DlClientListBmclapiMain) Public DlClientListBmclapiLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Bmclapi", AddressOf DlClientListBmclapiMain)
Private Sub DlClientListBmclapiMain(Loader As LoaderTask(Of Integer, 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 = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/mc/game/version_manifest.json", IsJson:=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 & ")")
'添加 PCL 特供项 '添加 PCL 特供项
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")))
'检查是否有要求的版本(#5195)
If Not String.IsNullOrEmpty(Loader.Input) Then
Dim Id = Loader.Input
If Not DlClientListLoader.Output.Value("versions").Any(Function(v) v("id") = Id) Then
Throw New Exception("BMCLAPI 源未包含目标版本 " & Id)
End If
End If
'返回 '返回
Loader.Output = New DlClientListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Json} Loader.Output = New DlClientListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Json}
Catch ex As Exception Catch ex As Exception
@@ -250,26 +253,31 @@
''' </summary> ''' </summary>
Public Function DlClientListGet(Id As String) Public Function DlClientListGet(Id As String)
Try Try
'确认 Minecraft 版本列表已完成获取
Select Case DlClientListLoader.State
Case LoadState.Loading
DlClientListLoader.WaitForExit()
Case LoadState.Failed, LoadState.Aborted, LoadState.Waiting
DlClientListLoader.WaitForExit(IsForceRestart:=True)
End Select
'确认版本格式标准 '确认版本格式标准
Id = Id.Replace("_", "-") '1.7.10_pre4 在版本列表中显示为 1.7.10-pre4 Id = Id.Replace("_", "-") '1.7.10_pre4 在版本列表中显示为 1.7.10-pre4
If Id <> "1.0" AndAlso Id.EndsWithF(".0") Then Id = Left(Id, Id.Length - 2) 'OptiFine 1.8 的下载会触发此问题,显示版本为 1.8.0 If Id <> "1.0" AndAlso Id.EndsWithF(".0") Then Id = Left(Id, Id.Length - 2) 'OptiFine 1.8 的下载会触发此问题,显示版本为 1.8.0
'查找版本并开始 '获取 Minecraft 版本列表
Select Case DlClientListLoader.State
Case LoadState.Finished
'从当前的结果获取目标版本…
For Each Version As JObject In DlClientListLoader.Output.Value("versions")
If Version("id") = Id Then Return Version("url").ToString
Next
'…如果没有,则重新尝试获取(在版本刚更新时可能出现这种情况,#5195)
DlClientListLoader.WaitForExit(Id, IsForceRestart:=True)
Case LoadState.Loading
DlClientListLoader.WaitForExit(Id)
Case LoadState.Failed, LoadState.Aborted, LoadState.Waiting
DlClientListLoader.WaitForExit(Id, IsForceRestart:=True)
End Select
'重新查找版本
For Each Version As JObject In DlClientListLoader.Output.Value("versions") For Each Version As JObject In DlClientListLoader.Output.Value("versions")
If Version("id") = Id Then If Version("id") = Id Then Return Version("url").ToString
Return Version("url").ToString
End If
Next Next
Log("未发现版本 " & Id & " 的 json 下载地址,版本列表返回为:" & vbCrLf & DlClientListLoader.Output.Value.ToString, LogLevel.Debug) Log($"未发现版本 {Id} 的 json 下载地址,版本列表返回为:{vbCrLf}{DlClientListLoader.Output.Value.ToString}", LogLevel.Debug)
Return Nothing Return Nothing
Catch ex As Exception Catch ex As Exception
Log(ex, "获取版本 " & Id & " 的 json 下载地址失败") Log(ex, $"获取版本 {Id} 的 json 下载地址失败")
Return Nothing Return Nothing
End Try End Try
End Function End Function
@@ -342,17 +350,17 @@
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),
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListOfficialLoader, 60) New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListOfficialLoader, 30 + 60)
}, Loader.IsForceRestarting) }, Loader.IsForceRestarting)
Case 1 Case 1
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)(DlOptiFineListOfficialLoader, 5), New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListOfficialLoader, 5),
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 35) New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 5 + 30)
}, Loader.IsForceRestarting) }, Loader.IsForceRestarting)
Case Else Case Else
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)(DlOptiFineListOfficialLoader, 60), New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListOfficialLoader, 60),
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 60) New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 60 + 60)
}, Loader.IsForceRestarting) }, Loader.IsForceRestarting)
End Select End Select
End Sub End Sub
@@ -448,17 +456,17 @@
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),
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListOfficialLoader, 60) New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListOfficialLoader, 30 + 60)
}, Loader.IsForceRestarting) }, Loader.IsForceRestarting)
Case 1 Case 1
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)(DlForgeListOfficialLoader, 5), New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListOfficialLoader, 5),
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 35) New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 5 + 30)
}, Loader.IsForceRestarting) }, Loader.IsForceRestarting)
Case Else Case Else
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)(DlForgeListOfficialLoader, 60), New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListOfficialLoader, 60),
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 60) New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 60 + 60)
}, Loader.IsForceRestarting) }, Loader.IsForceRestarting)
End Select End Select
End Sub End Sub
@@ -593,17 +601,17 @@
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),
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionOfficialLoader, 60) New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionOfficialLoader, 30 + 60)
}, Loader.IsForceRestarting) }, Loader.IsForceRestarting)
Case 1 Case 1
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)(DlForgeVersionOfficialLoader, 5), New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionOfficialLoader, 5),
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 35) New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 5 + 30)
}, Loader.IsForceRestarting) }, Loader.IsForceRestarting)
Case Else Case Else
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)(DlForgeVersionOfficialLoader, 60), New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionOfficialLoader, 60),
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 60) New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 60 + 60)
}, Loader.IsForceRestarting) }, Loader.IsForceRestarting)
End Select End Select
End Sub End Sub
@@ -614,12 +622,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 = NetGetCodeByDownload("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" & Result = NetGetCodeByLoader("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", UseBrowserUserAgent:=True)
Catch ex As Exception Catch ex As Exception
If GetExceptionSummary(ex).Contains("(404)") Then If GetExceptionSummary(ex).Contains("(404)") Then
Throw New Exception("没有可用版本") Throw New Exception("不可用")
Else Else
Throw Throw
End If End If
@@ -677,7 +685,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
@@ -732,7 +740,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
@@ -785,7 +793,7 @@
Inherit = "1.20.1" Inherit = "1.20.1"
Else '20.4.30-beta Else '20.4.30-beta
VersionName = ApiName VersionName = ApiName
Version = New Version(ApiName.Before("-")) Version = New Version(ApiName.BeforeFirst("-"))
Inherit = $"1.{Version.Major}" & If(Version.Minor = 0, "", "." & Version.Minor) Inherit = $"1.{Version.Major}" & If(Version.Minor = 0, "", "." & Version.Minor)
End If End If
End Sub End Sub
@@ -800,17 +808,17 @@
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),
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListOfficialLoader, 60) New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListOfficialLoader, 30 + 60)
}, Loader.IsForceRestarting) }, Loader.IsForceRestarting)
Case 1 Case 1
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)(DlNeoForgeListOfficialLoader, 5), New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListOfficialLoader, 5),
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 35) New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 5 + 30)
}, Loader.IsForceRestarting) }, Loader.IsForceRestarting)
Case Else Case Else
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)(DlNeoForgeListOfficialLoader, 60), New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListOfficialLoader, 60),
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 60) New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 60 + 60)
}, Loader.IsForceRestarting) }, Loader.IsForceRestarting)
End Select End Select
End Sub End Sub
@@ -821,8 +829,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 = NetGetCodeByDownload("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/neoforge", UseBrowserUserAgent:=True, IsJson:=True) Dim ResultLatest As String = NetGetCodeByLoader("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/neoforge", UseBrowserUserAgent:=True, IsJson:=True)
Dim ResultLegacy As String = NetGetCodeByDownload("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/forge", UseBrowserUserAgent:=True, IsJson:=True) Dim ResultLegacy As String = NetGetCodeByLoader("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/forge", UseBrowserUserAgent:=True, IsJson:=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
@@ -839,8 +847,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 = NetGetCodeByDownload("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/neoforge", UseBrowserUserAgent:=True, IsJson:=True) Dim ResultLatest As String = NetGetCodeByLoader("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/neoforge", UseBrowserUserAgent:=True, IsJson:=True)
Dim ResultLegacy As String = NetGetCodeByDownload("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/forge", UseBrowserUserAgent:=True, IsJson:=True) Dim ResultLegacy As String = NetGetCodeByLoader("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/forge", UseBrowserUserAgent:=True, IsJson:=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
@@ -857,7 +865,7 @@
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)).ToList
If Not Versions.Any() Then Throw New Exception("没有可用版本") If Not Versions.Any() Then Throw New Exception("不可用")
Versions = Versions.OrderByDescending(Function(a) a.Version).ToList Versions = Versions.OrderByDescending(Function(a) a.Version).ToList
Return Versions Return Versions
End Function End Function
@@ -925,17 +933,17 @@
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),
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListOfficialLoader, 60) New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListOfficialLoader, 30 + 60)
}, Loader.IsForceRestarting) }, Loader.IsForceRestarting)
Case 1 Case 1
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)(DlLiteLoaderListOfficialLoader, 5), New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListOfficialLoader, 5),
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 35) New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 5 + 30)
}, Loader.IsForceRestarting) }, Loader.IsForceRestarting)
Case Else Case Else
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)(DlLiteLoaderListOfficialLoader, 60), New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListOfficialLoader, 60),
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 60) New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 60 + 60)
}, Loader.IsForceRestarting) }, Loader.IsForceRestarting)
End Select End Select
End Sub End Sub
@@ -1024,17 +1032,17 @@
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),
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListOfficialLoader, 60) New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListOfficialLoader, 30 + 60)
}, Loader.IsForceRestarting) }, Loader.IsForceRestarting)
Case 1 Case 1
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)(DlFabricListOfficialLoader, 5), New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListOfficialLoader, 5),
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 35) New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 5 + 30)
}, Loader.IsForceRestarting) }, Loader.IsForceRestarting)
Case Else Case Else
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)(DlFabricListOfficialLoader, 60), New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListOfficialLoader, 60),
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 60) New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 60 + 60)
}, Loader.IsForceRestarting) }, Loader.IsForceRestarting)
End Select End Select
End Sub End Sub
@@ -1087,29 +1095,34 @@
''' <summary> ''' <summary>
''' 对可能涉及 Mod 镜像源的请求进行处理,返回字符串或 JObject。 ''' 对可能涉及 Mod 镜像源的请求进行处理,返回字符串或 JObject。
''' 调用 NetGetCodeByRequestOnce。 ''' 调用 NetGetCodeByRequest,会进行重试。
''' </summary> ''' </summary>
Public Function DlModRequest(Url As String, Optional IsJson As Boolean = False) As Object Public Function DlModRequest(Url As String, Optional IsJson As Boolean = False) As Object
Dim McimUrl As String = DlSourceModGet(Url)
Dim Urls As New List(Of KeyValuePair(Of String, Integer)) Dim Urls As New List(Of KeyValuePair(Of String, Integer))
If McimUrl <> Url Then Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
Select Case Setup.Get("ToolDownloadMod") Urls.Add(New KeyValuePair(Of String, Integer)(Url, 20))
Case 0 'Dim McimUrl As String = DlSourceModGet(Url)
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30)) 'If McimUrl <> Url Then
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60)) ' Select Case Setup.Get("ToolDownloadMod")
Case 1 ' Case 0
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)(McimUrl, 35)) ' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
Case Else ' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 15))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60)) ' Case 1
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60)) ' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
End Select ' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 5))
End If ' 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 = "" Dim Exs As String = ""
For Each Source In Urls For Each Source In Urls
Try Try
Return NetGetCodeByRequestOnce(Source.Key, Encode:=Encoding.UTF8, Timeout:=Source.Value * 1000, Return NetGetCodeByRequestOnce(Source.Key, Encode:=Encoding.UTF8, Timeout:=Source.Value * 1000, IsJson:=IsJson, UseBrowserUserAgent:=True)
IsJson:=IsJson, UseBrowserUserAgent:=True)
Catch ex As Exception Catch ex As Exception
Exs += ex.Message + vbCrLf Exs += ex.Message + vbCrLf
End Try End Try
@@ -1119,28 +1132,34 @@
''' <summary> ''' <summary>
''' 对可能涉及 Mod 镜像源的请求进行处理。 ''' 对可能涉及 Mod 镜像源的请求进行处理。
''' 调用 NetRequestOnce。 ''' 调用 NetRequest,会进行重试。
''' </summary> ''' </summary>
Public Function DlModRequest(Url As String, Method As String, Data As String, ContentType As String, Optional Headers As Dictionary(Of String, String) = Nothing) As String Public Function DlModRequest(Url As String, Method As String, Data As String, ContentType As String) As String
Dim McimUrl As String = DlSourceModGet(Url)
Dim Urls As New List(Of KeyValuePair(Of String, Integer)) Dim Urls As New List(Of KeyValuePair(Of String, Integer))
If McimUrl <> Url Then Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
Select Case Setup.Get("ToolDownloadMod") Urls.Add(New KeyValuePair(Of String, Integer)(Url, 20))
Case 0 'Dim McimUrl As String = DlSourceModGet(Url)
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30)) 'If McimUrl <> Url Then
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60)) ' Select Case Setup.Get("ToolDownloadMod")
Case 1 ' Case 0
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)(McimUrl, 35)) ' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
Case Else ' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 15))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60)) ' Case 1
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60)) ' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
End Select ' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 5))
End If ' 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 = "" 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, Headers:=Headers) Return NetRequestOnce(Source.Key, Method, Data, ContentType, Timeout:=Source.Value * 1000)
Catch ex As Exception Catch ex As Exception
Exs += ex.Message + vbCrLf Exs += ex.Message + vbCrLf
End Try End Try
@@ -1164,28 +1183,42 @@
End Function End Function
Public Function DlSourceLibraryGet(Original As String) As String() Public Function DlSourceLibraryGet(Original As String) As String()
Return { If {"minecraftforge", "fabricmc", "neoforged"}.Any(Function(k) Original.Contains(k)) Then '不添加原版源
Original. Return {
Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/maven"). Original.
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/maven"). Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/maven").
Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/maven"), Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/maven").
Original. Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/maven"),
Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/libraries"). Original.
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/libraries"). Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/libraries").
Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/libraries"), Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/libraries").
Original Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/libraries")
} }
Else
Return {
Original.
Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/maven").
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/maven").
Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/maven"),
Original.
Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/libraries").
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/libraries").
Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/libraries"),
Original
}
End If
End Function End Function
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"). 'Return Original.
Replace("staging-api.modrinth.com", "mod.mcimirror.top/modrinth"). ' Replace("api.modrinth.com", "mod.mcimirror.top/modrinth").
Replace("cdn.modrinth.com", "mod.mcimirror.top"). ' Replace("staging-api.modrinth.com", "mod.mcimirror.top/modrinth").
Replace("api.curseforge.com", "mod.mcimirror.top/curseforge"). ' Replace("cdn.modrinth.com", "mod.mcimirror.top").
Replace("edge.forgecdn.net", "mod.mcimirror.top"). ' Replace("api.curseforge.com", "mod.mcimirror.top/curseforge").
Replace("mediafilez.forgecdn.net", "mod.mcimirror.top"). ' Replace("edge.forgecdn.net", "mod.mcimirror.top").
Replace("media.forgecdn.net", "mod.mcimirror.top") ' Replace("mediafilez.forgecdn.net", "mod.mcimirror.top").
' Replace("media.forgecdn.net", "mod.mcimirror.top")
End Function End Function
Public Function DlSourceLauncherOrMetaGet(Original As String) As String() Public Function DlSourceLauncherOrMetaGet(Original As String) As String()
@@ -1205,71 +1238,63 @@
Optional IsForceRestart As Boolean = False) Optional IsForceRestart As Boolean = False)
Dim WaitCycle As Integer = 0 Dim WaitCycle As Integer = 0
Do While True Do While True
'检查加载结束 '检查状态
Dim IsAllFailed As Boolean = True Dim BeforeLoadersAllFailed As Boolean = True
For Each SubLoader In LoaderList For Each SubLoader In LoaderList
If WaitCycle = 0 Then If WaitCycle = 0 Then '判断是否可以不加载,直接使用已经加载好的结果
'如果要强制刷新,就不使用已经加载好的值 If IsForceRestart Then Continue For '强制刷新,不行
If IsForceRestart Then Exit For
'如果输入不一样,就不使用已经加载好的值
If (SubLoader.Key.Input Is Nothing Xor MainLoader.Input Is Nothing) OrElse If (SubLoader.Key.Input Is Nothing Xor MainLoader.Input Is Nothing) OrElse
(SubLoader.Key.Input IsNot Nothing AndAlso Not SubLoader.Key.Input.Equals(MainLoader.Input)) Then Continue For (SubLoader.Key.Input IsNot Nothing AndAlso Not SubLoader.Key.Input.Equals(MainLoader.Input)) Then Continue For '父子加载器的输入不一样,也不行
End If End If
If SubLoader.Key.State <> LoadState.Failed Then IsAllFailed = False If SubLoader.Key.State <> LoadState.Failed Then BeforeLoadersAllFailed = False
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) DlSourceLoaderAbort(LoaderList)
Exit Sub Exit Sub
ElseIf IsAllFailed Then ElseIf BeforeLoadersAllFailed Then
'此前的加载器全部失败,直接启动后续加载器
If WaitCycle < SubLoader.Value * 100 Then WaitCycle = SubLoader.Value * 100 If WaitCycle < SubLoader.Value * 100 Then WaitCycle = SubLoader.Value * 100
End If End If
'由于 Forge BMCLAPI 没有可用版本导致强制失败
'在没有可用版本时,官方源会一直卡住,直接使用 BMCLAPI 判定失败即可
If SubLoader.Key.Error IsNot Nothing AndAlso SubLoader.Key.Error.Message.Contains("没有可用版本") Then
For Each SubLoader2 In LoaderList
If WaitCycle < SubLoader2.Value * 100 Then WaitCycle = SubLoader2.Value * 100
Next
End If
Next Next
'启动加载源 '第一轮时:既然不直接使用已经加载好的结果,那就启动第一个加载器
If WaitCycle = 0 Then If WaitCycle = 0 Then
'启动第一个源 LoaderList.First.Key.Start(MainLoader.Input, IsForceRestart)
LoaderList(0).Key.Start(MainLoader.Input, IsForceRestart) For Each Loader In LoaderList.Skip(1)
'将其他源标记为未启动,以确保可以切换下载源(#184) Loader.Key.State = LoadState.Waiting '将其他源标记为未启动,以确保可以切换下载源(#184)
For i = 1 To LoaderList.Count - 1
LoaderList(i).Key.State = LoadState.Waiting
Next Next
End If End If
'检查加载器失败或超时
For i = 0 To LoaderList.Count - 1 For i = 0 To LoaderList.Count - 1
If WaitCycle = LoaderList(i).Value * 100 Then If WaitCycle <> LoaderList(i).Value * 100 Then Continue For
If i < LoaderList.Count - 1 Then If i < LoaderList.Count - 1 AndAlso Not LoaderList.All(Function(l) l.Key.State = LoadState.Failed) Then
'启动下一个源 '若还有下一个源,则启动下一个源
LoaderList(i + 1).Key.Start(MainLoader.Input, IsForceRestart) LoaderList(i + 1).Key.Start(MainLoader.Input, IsForceRestart)
Else Else
'失败 '若没有,则失败
Dim ErrorInfo As Exception = Nothing Dim ErrorInfo As Exception = Nothing
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.Contains("不可用") Then
ErrorInfo = LoaderList(ii).Key.Error ErrorInfo = LoaderList(ii).Key.Error
End If
End If End If
Next End If
If ErrorInfo Is Nothing Then ErrorInfo = New TimeoutException("下载源连接超时") Next
DlSourceLoaderAbort(LoaderList) If ErrorInfo Is Nothing Then ErrorInfo = New TimeoutException("下载源连接超时")
Throw ErrorInfo DlSourceLoaderAbort(LoaderList)
End If Throw ErrorInfo
Exit For
End If End If
Exit For
Next Next
'计时 '计时
Thread.Sleep(10)
WaitCycle += 1
'检查父加载器中断
If MainLoader.IsAborted Then If MainLoader.IsAborted Then
DlSourceLoaderAbort(LoaderList) DlSourceLoaderAbort(LoaderList)
Exit Sub Exit Sub
End If End If
Thread.Sleep(10)
WaitCycle += 1
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 DlSourceLoaderAbort(Of InputType, OutputType)(LoaderList As List(Of KeyValuePair(Of LoaderTask(Of InputType, OutputType), Integer)))
@@ -131,7 +131,7 @@
Version = New Version(1, Version.Major, Version.Build, Version.Revision) Version = New Version(1, Version.Major, Version.Build, Version.Revision)
End If End If
Is64Bit = Output.Contains("64-bit") Is64Bit = Output.Contains("64-bit")
If Version.Minor <= 4 OrElse Version.Minor >= 25 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 '基于 #2249 发现 JRE 17 似乎也导致了 Forge 安装失败,干脆禁用更多版本的 JRE
@@ -342,7 +342,7 @@ RetryGet:
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.VersionCode & If(ShowRevision, "." & UserJava.Version.MajorRevision & "." & UserJava.Version.MinorRevision, "")
If Setup.Get("LaunchAdvanceJava") OrElse (RelatedVersion IsNot Nothing AndAlso Setup.Get("VersionAdvanceJava", RelatedVersion)) Then If RelatedVersion IsNot Nothing AndAlso Setup.Get("VersionAdvanceJava", RelatedVersion) 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}
@@ -372,6 +372,8 @@ ExitUserJavaCheck:
For Each Java In AllowedJavaList For Each Java In AllowedJavaList
'如果在官启文件夹启动,会将官启自带 Java 错误视作 MC 文件夹指定 Java,导致了 #2054 的第二例 '如果在官启文件夹启动,会将官启自带 Java 错误视作 MC 文件夹指定 Java,导致了 #2054 的第二例
If Java.PathFolder.Contains(".minecraft\cache\java") Then Continue For If Java.PathFolder.Contains(".minecraft\cache\java") Then Continue For
'#5780
If Java.PathFolder.Contains("PCL\MyDownload") Then Continue For
If TargetJavaList.Contains(Java) Then If TargetJavaList.Contains(Java) Then
'直接使用指定的 Java '直接使用指定的 Java
AllowedJavaList = New List(Of JavaEntry) From {Java} AllowedJavaList = New List(Of JavaEntry) From {Java}
@@ -382,7 +384,7 @@ ExitUserJavaCheck:
UserPass: UserPass:
'对适合的 Java 进行排序 '对适合的 Java 进行排序
AllowedJavaList = Sort(AllowedJavaList, AddressOf JavaSorter) AllowedJavaList = AllowedJavaList.Sort(AddressOf JavaSorter)
Log($"[Java] 排序后的 Java 优先顺序:") Log($"[Java] 排序后的 Java 优先顺序:")
For Each Java In AllowedJavaList For Each Java In AllowedJavaList
Log($"[Java] - {Java}") Log($"[Java] - {Java}")
@@ -489,16 +491,18 @@ NoUserJava:
Public JavaSearchLoader As New LoaderTask(Of Integer, Integer)("查找 Java", AddressOf JavaSearchLoaderSub) With {.ProgressWeight = 2} Public JavaSearchLoader As New LoaderTask(Of Integer, Integer)("查找 Java", AddressOf JavaSearchLoaderSub) With {.ProgressWeight = 2}
Private Sub JavaSearchLoaderSub(Loader As LoaderTask(Of Integer, Integer)) Private Sub JavaSearchLoaderSub(Loader As LoaderTask(Of Integer, Integer))
If FrmSetupLaunch IsNot Nothing Then If FrmSetupLaunch IsNot Nothing Then
RunInUiWait(Sub() RunInUiWait(
FrmSetupLaunch.ComboArgumentJava.Items.Clear() Sub()
FrmSetupLaunch.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True}) FrmSetupLaunch.ComboArgumentJava.Items.Clear()
End Sub) FrmSetupLaunch.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True})
End Sub)
End If End If
If FrmVersionSetup IsNot Nothing Then If FrmVersionSetup IsNot Nothing Then
RunInUiWait(Sub() RunInUiWait(
FrmVersionSetup.ComboArgumentJava.Items.Clear() Sub()
FrmVersionSetup.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True}) FrmVersionSetup.ComboArgumentJava.Items.Clear()
End Sub) FrmVersionSetup.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True})
End Sub)
End If End If
Try Try
@@ -520,6 +524,7 @@ NoUserJava:
Next Next
'查找磁盘中的 Java '查找磁盘中的 Java
For Each Disk As DriveInfo In DriveInfo.GetDrives() For Each Disk As DriveInfo In DriveInfo.GetDrives()
If Disk.DriveType = DriveType.Network Then Continue For '跳过网络驱动器(#3705)
JavaSearchFolder(Disk.Name, JavaPreList, False) JavaSearchFolder(Disk.Name, JavaPreList, False)
Next Next
'查找 APPDATA 文件夹中的 Java '查找 APPDATA 文件夹中的 Java
@@ -552,7 +557,7 @@ NoUserJava:
'若不全为特殊引用,则清除特殊引用的地址 '若不全为特殊引用,则清除特殊引用的地址
Dim JavaWithoutInherit As New Dictionary(Of String, Boolean) Dim JavaWithoutInherit As New Dictionary(Of String, Boolean)
For Each Pair In JavaPreList For Each Pair In JavaPreList
If Pair.Key.Contains("java8path_target_") OrElse Pair.Key.Contains("javapath_target_") OrElse Pair.Key.Contains("javatmp") Then If Pair.Key.Contains("java8path_target_") OrElse Pair.Key.Contains("javapath_target_") OrElse Pair.Key.Contains("javatmp") OrElse Pair.Key.ContainsF("system32") Then
Log("[Java] 位于 " & Pair.Key & " 的 Java 包含特殊引用") Log("[Java] 位于 " & Pair.Key & " 的 Java 包含特殊引用")
Else Else
Log("[Java] 位于 " & Pair.Key & " 的 Java 不含特殊引用") Log("[Java] 位于 " & Pair.Key & " 的 Java 不含特殊引用")
@@ -583,7 +588,7 @@ NoUserJava:
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.ToLower = b.Key.ToLower) '#794
NewJavaList.Add(New JavaEntry(Entry.Key, Entry.Value)) NewJavaList.Add(New JavaEntry(Entry.Key, Entry.Value))
Next Next
NewJavaList = Sort(JavaCheckList(NewJavaList), AddressOf JavaSorter) NewJavaList = JavaCheckList(NewJavaList).Sort(AddressOf JavaSorter)
'修改设置项 '修改设置项
Dim AllList As New JArray Dim AllList As New JArray
@@ -650,7 +655,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(OriginalPath), Results, Source, IsFullSearch) JavaSearchFolder(New DirectoryInfo(ShortenPath(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
@@ -671,18 +676,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
Dim Keywords = {"java", "jdk", "env", "环境", "run", "软件", "jre", "mc", "dragon", Dim Keywords = {"java", "jdk", "env", "环境", "run", "软件", "jre", "mc", "dragon",
"soft", "cache", "temp", "corretto", "roaming", "users", "craft", "program", "世界", "net", "soft", "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", "forge", "原版", "optifine", "官方", "启动", "hmcl", "mod", "高清",
"download", "launch", "程序", "path", "version", "baka", "pcl", "zulu", "local", "packages", "download", "launch", "程序", "path", "version", "baka", "pcl", "zulu", "local", "packages",
"4297127d64ec6", "国服", "网易", "ext", "netease", "1.", "启动"} "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).ToLower '用于搜索的字符串
If IsFullSearch OrElse FolderInfo.Parent.Name.ToLower = "users" OrElse If IsFullSearch OrElse
Keywords.Any(Function(w) SearchEntry.Contains(w)) OrElse SearchEntry = "bin" Then OriginalPath.Name.ToLower = "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
@@ -738,7 +744,7 @@ Wait:
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 Integer, List(Of NetFile)))
Log("[Java] 开始获取 Java 下载信息") Log("[Java] 开始获取 Java 下载信息")
Dim IndexFileStr As String = NetGetCodeByDownload( Dim IndexFileStr As String = NetGetCodeByLoader(
{"https://bmclapi2.bangbang93.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json", {"https://bmclapi2.bangbang93.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json",
"https://piston-meta.mojang.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json"}, "https://piston-meta.mojang.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json"},
IsJson:=True) IsJson:=True)
@@ -750,7 +756,7 @@ Wait:
Dim Address As String = TargetEntry.Value("manifest")("url") Dim Address As String = TargetEntry.Value("manifest")("url")
Log($"[Java] 准备下载 Java {TargetEntry.Value("version")("name")}({TargetEntry.Key}):{Address}") Log($"[Java] 准备下载 Java {TargetEntry.Value("version")("name")}({TargetEntry.Key}):{Address}")
'获取文件列表 '获取文件列表
Dim ListFileStr As String = NetGetCodeByDownload({Address.Replace("piston-meta.mojang.com", "bmclapi2.bangbang93.com"), Address}, IsJson:=True) Dim ListFileStr As String = NetGetCodeByLoader({Address.Replace("piston-meta.mojang.com", "bmclapi2.bangbang93.com"), Address}, IsJson:=True)
LastJavaBaseDir = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\runtime\" & TargetEntry.Key & "\" LastJavaBaseDir = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\runtime\" & TargetEntry.Key & "\"
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")
File diff suppressed because it is too large Load Diff
@@ -73,7 +73,8 @@ Public Module ModMinecraft
End If End If
Dim Name As String = Folder.Split(">")(0) Dim Name As String = Folder.Split(">")(0)
Dim Path As String = Folder.Split(">")(1) Dim Path As String = Folder.Split(">")(1)
If CheckPermission(Path) Then Try
CheckPermissionWithException(Path)
'若已有该文件夹,则直接重命名;没有则添加 '若已有该文件夹,则直接重命名;没有则添加
Dim Renamed As Boolean = False Dim Renamed As Boolean = False
For Each OriginalFolder As McFolder In CacheMcFolderList For Each OriginalFolder As McFolder In CacheMcFolderList
@@ -84,9 +85,10 @@ Public Module ModMinecraft
End If End If
Next Next
If Not Renamed Then CacheMcFolderList.Add(New McFolder With {.Name = Name, .Path = Path, .Type = McFolderType.Custom}) If Not Renamed Then CacheMcFolderList.Add(New McFolder With {.Name = Name, .Path = Path, .Type = McFolderType.Custom})
Else Catch ex As Exception
Hint("无效的 Minecraft 文件夹:" & Path, HintType.Critical) MyMsgBox("失效的 Minecraft 文件夹:" & vbCrLf & Path & vbCrLf & vbCrLf & GetExceptionSummary(ex), "Minecraft 文件夹失效", IsWarn:=True)
End If Log(ex, $"无法访问 Minecraft 文件夹 {Path}")
End Try
Next Next
'将自定义文件夹情况同步到设置 '将自定义文件夹情况同步到设置
@@ -205,53 +207,46 @@ Public Module ModMinecraft
''' </summary> ''' </summary>
Public ReadOnly Property PathIndie As String Public ReadOnly Property PathIndie As String
Get Get
Return GetPathIndie(Modable) InitPathIndie(Modable)
Return If(Setup.Get("VersionArgumentIndieV2", Version:=Me), Path, PathMcFolder)
End Get End Get
End Property End Property
''' <summary> ''' <summary>
''' 在不加载版本的情况下获取版本隔离目录。 ''' 决定该版本是否应该被隔离。
''' </summary> ''' </summary>
Public Function GetPathIndie(Modable As Boolean) As String Public Sub InitPathIndie(Modable As Boolean)
Dim IndieType As Integer = Setup.Get("LaunchArgumentIndie") If Not Setup.IsUnset("VersionArgumentIndieV2", Version:=Me) Then Return
Select Case Setup.Get("VersionArgumentIndie", Version:=Me) Dim ShouldBeIndie =
Case -1 Function() As Boolean
'尚未判断 '从老的版本独立设置中迁移:-1 未决定,0 使用全局设置,1 手动开启,2 手动关闭
Dim ModFolder As New DirectoryInfo(Path & "mods\") If Not Setup.IsUnset("VersionArgumentIndie", Version:=Me) AndAlso Setup.Get("VersionArgumentIndie", Version:=Me) > 0 Then
Dim SaveFolder As New DirectoryInfo(Path & "saves\") Log($"[Minecraft] 版本隔离初始化({Name}):从老的版本独立设置中迁移")
If (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Any) OrElse Return Setup.Get("VersionArgumentIndie", Version:=Me) = 1
(SaveFolder.Exists AndAlso SaveFolder.EnumerateFiles.Any) Then End If
'自动开启 '若版本文件夹下包含 mods 或 saves 文件夹,则自动开启版本隔离
Setup.Set("VersionArgumentIndie", 1, Version:=Me) Dim ModFolder As New DirectoryInfo(Path & "mods\")
Log("[Setup] 已自动开启单版本隔离:" & Name) Dim SaveFolder As New DirectoryInfo(Path & "saves\")
IndieType = 4 If (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Any) OrElse (SaveFolder.Exists AndAlso SaveFolder.EnumerateFiles.Any) Then
Else Log($"[Minecraft] 版本隔离初始化({Name}):版本文件夹下存在 mods 或 saves 文件夹,自动开启")
'使用全局设置 Return True
Setup.Set("VersionArgumentIndie", 0, Version:=Me) End If
Log("[Setup] 版本隔离使用全局设置:" & Name) '根据全局的默认设置决定是否隔离
End If Log($"[Minecraft] 版本隔离初始化({Name}):从全局默认设置中({Setup.Get("LaunchArgumentIndieV2")})判断")
Case 0 Select Case Setup.Get("LaunchArgumentIndieV2")
'使用全局设置 Case 0 '关闭
Case 1 Return False
'开启 Case 1 '仅隔离可安装 Mod 的版本
IndieType = 4 Return Modable
Case 2 Case 2 '仅隔离非正式版
'关闭 Return State = McVersionState.Fool OrElse State = McVersionState.Old OrElse State = McVersionState.Snapshot
IndieType = 0 Case 3 '隔离非正式版与可安装 Mod 的版本
End Select Return Modable OrElse State = McVersionState.Fool OrElse State = McVersionState.Old OrElse State = McVersionState.Snapshot
Select Case IndieType Case Else '隔离所有版本
Case 0 '关闭 Return True
Case 1 '仅隔离可安装 Mod 的版本 End Select
If Modable Then Return Path End Function
Case 2 '仅隔离非正式版 Setup.Set("VersionArgumentIndieV2", ShouldBeIndie(), Version:=Me)
If State = McVersionState.Fool OrElse State = McVersionState.Old OrElse State = McVersionState.Snapshot Then Return Path End Sub
Case 3 '隔离非正式版与可安装 Mod 的版本
If Modable Then Return Path
If State = McVersionState.Fool OrElse State = McVersionState.Old OrElse State = McVersionState.Snapshot Then Return Path
Case 4 '隔离所有版本
Return Path
End Select
Return PathMcFolder
End Function
''' <summary> ''' <summary>
''' 该版本的版本文件夹名称。 ''' 该版本的版本文件夹名称。
@@ -394,27 +389,13 @@ Public Module ModMinecraft
GoTo VersionSearchFinish GoTo VersionSearchFinish
End If End If
'从 jar 文件的 version.json 中获取版本号 '从 jar 文件的 version.json 中获取版本号
If File.Exists(Path & Name & ".jar") Then If JsonVersion?("name") IsNot Nothing Then
Try Dim JsonVerName As String = JsonVersion("name").ToString
Using JarArchive As New ZipArchive(New FileStream(Path & Name & ".jar", FileMode.Open, FileAccess.Read, FileShare.ReadWrite)) If JsonVerName.Length < 32 Then '因为 wiki 说这玩意儿可能是个 hash,虽然我没发现
Dim VersionJson As ZipArchiveEntry = JarArchive.GetEntry("version.json") _Version.McName = JsonVerName
If VersionJson IsNot Nothing Then Log("[Minecraft] 从版本 jar 中的 version.json 获取到版本号:" & JsonVerName)
Using VersionJsonStream As New StreamReader(VersionJson.Open) GoTo VersionSearchFinish
Dim VersionJsonObj As JObject = GetJson(VersionJsonStream.ReadToEnd) End If
If VersionJsonObj("id") IsNot Nothing Then
Dim VersionId As String = VersionJsonObj("id").ToString
If VersionId.Length < 32 Then '因为 wiki 说这玩意儿可能是个 hash,虽然我没发现
_Version.McName = VersionId
Log("[Minecraft] 从版本 jar 中的 version.json 获取到版本号:" & VersionId)
GoTo VersionSearchFinish
End If
End If
End Using
End If
End Using
Catch ex As Exception
Log(ex, "从版本 jar 中的 version.json 获取版本号失败")
End Try
End If End If
'非准确的版本判断警告 '非准确的版本判断警告
Log("[Minecraft] 无法完全确认 MC 版本号的版本:" & Name) Log("[Minecraft] 无法完全确认 MC 版本号的版本:" & Name)
@@ -475,22 +456,37 @@ VersionSearchFinish:
''' </summary> ''' </summary>
Public Property JsonText As String Public Property JsonText As String
Get Get
'快速检查 JSON 是否以 { 开头、} 结尾;忽略空白字符
Dim FastJsonCheck =
Function(Json As String) As Boolean
Dim TrimedJson As String = Json.Trim()
Return TrimedJson.StartsWithF("{") AndAlso TrimedJson.EndsWithF("}")
End Function
If _JsonText Is Nothing Then If _JsonText Is Nothing Then
If Not File.Exists(Path & Name & ".json") Then Throw New Exception("未找到版本 json 文件:" & Path & Name & ".json") Dim JsonPath As String = Path & Name & ".json"
_JsonText = ReadFile(Path & Name & ".json") If Not File.Exists(JsonPath) Then
'如果 ReadFile 失败会返回空字符串;这可能是由于文件被临时占用,故延时后重试 '如果文件夹下只有一个 JSON 文件,则将其作为版本 JSON
If _JsonText.Length = 0 Then Dim JsonFiles As String() = Directory.GetFiles(Path, "*.json")
If RunInUi() Then If JsonFiles.Count = 1 Then
Log("[Minecraft] 版本 json 文件为空或读取失败,由于代码在主线程运行,将不再进行重试", LogLevel.Debug) JsonPath = JsonFiles(0)
Throw New Exception("版本 Json 文件为空或读取失败") Log("[Minecraft] 未找到同名版本 JSON,自动换用 " & JsonPath, LogLevel.Debug)
Else Else
Log("[Minecraft] 版本 json 文件为空或读取失败,将在 2s 后重试读取(" & Path & Name & ".json)", LogLevel.Debug) Throw New Exception($"未找到版本 JSON 文件:{Path}{Name}.json")
End If
End If
_JsonText = ReadFile(JsonPath)
'如果 ReadFile 失败会返回空字符串;这可能是由于文件被临时占用,故延时后重试
If Not FastJsonCheck(_JsonText) Then
If RunInUi() Then
Log("[Minecraft] 版本 JSON 文件为空或有误,由于代码在主线程运行,将不再进行重试", LogLevel.Debug)
GetJson(_JsonText) '触发异常
Else
Log($"[Minecraft] 版本 JSON 文件为空或有误,将在 2s 后重试读取({JsonPath})", LogLevel.Debug)
Thread.Sleep(2000) Thread.Sleep(2000)
_JsonText = ReadFile(Path & Name & ".json") _JsonText = ReadFile(JsonPath)
If _JsonText.Length = 0 Then Throw New Exception("版本 json 文件为空或读取失败") If Not FastJsonCheck(_JsonText) Then GetJson(_JsonText) '触发异常
End If End If
End If End If
If _JsonText.Length < 100 Then Throw New Exception("版本 json 文件有误,内容为:" & _JsonText)
End If End If
Return _JsonText Return _JsonText
End Get End Get
@@ -519,9 +515,8 @@ VersionSearchFinish:
For Each Subjson As JObject In _JsonObject("patches") For Each Subjson As JObject In _JsonObject("patches")
SubjsonList.Add(Subjson) SubjsonList.Add(Subjson)
Next Next
SubjsonList = Sort(SubjsonList, Function(Left As JObject, Right As JObject) As Boolean SubjsonList = SubjsonList.Sort(
Return Val(If(Left("priority"), "0").ToString) < Val(If(Right("priority"), "0").ToString) Function(Left, Right) Val(If(Left("priority"), "0").ToString) < Val(If(Right("priority"), "0").ToString))
End Function)
For Each Subjson As JObject In SubjsonList For Each Subjson As JObject In SubjsonList
Dim Id As String = Subjson("id") Dim Id As String = Subjson("id")
If Id IsNot Nothing Then If Id IsNot Nothing Then
@@ -562,11 +557,10 @@ Recheck:
GoTo Recheck GoTo Recheck
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "合并版本依赖项 json 失败(" & If(InheritVersion, "null").ToString & ")") Log(ex, "合并版本依赖项 JSON 失败(" & If(InheritVersion, "null").ToString & ")")
End Try End Try
Catch ex As Exception Catch ex As Exception
Log($"[Minecraft] 传入的版本 json 文件内容(共 {Text.Length} 字符,最多输出前 5000 字符):{vbCrLf}{Text.Substring(0, 5000)}") Throw New Exception("初始化版本 JSON 时失败(" & If(Name, "null") & ")", ex)
Throw New Exception("版本 json 不规范(" & If(Name, "null") & ")", ex)
End Try End Try
Try Try
'处理 JumpLoader '处理 JumpLoader
@@ -612,6 +606,35 @@ Recheck:
''' </summary> ''' </summary>
Public Property HasJumpLoader As Boolean = False Public Property HasJumpLoader As Boolean = False
''' <summary>
''' 版本 jar 中的 version.json 文件对象。
''' 若没有则返回 Nothing。
''' </summary>
Public ReadOnly Property JsonVersion As JObject
Get
If Not JsonVersionInited Then
JsonVersionInited = True
If File.Exists(Path & Name & ".jar") Then
Try
Using JarArchive As New ZipArchive(New FileStream(Path & Name & ".jar", FileMode.Open, FileAccess.Read, FileShare.ReadWrite))
Dim VersionJson As ZipArchiveEntry = JarArchive.GetEntry("version.json")
If VersionJson IsNot Nothing Then
Using VersionJsonStream As New StreamReader(VersionJson.Open)
_JsonVersion = GetJson(VersionJsonStream.ReadToEnd)
End Using
End If
End Using
Catch ex As Exception
Log(ex, "从版本 jar 中读取 version.json 失败")
End Try
End If
End If
Return _JsonVersion
End Get
End Property
Private JsonVersionInited As Boolean = False
Private _JsonVersion As JObject = Nothing
''' <summary> ''' <summary>
''' 该版本的依赖版本。若无依赖版本则为空字符串。 ''' 该版本的依赖版本。若无依赖版本则为空字符串。
''' </summary> ''' </summary>
@@ -775,37 +798,7 @@ ExitDataLoad:
End If End If
'确定版本描述 '确定版本描述
Dim CustomInfo As String = ReadIni(Path & "PCL\Setup.ini", "CustomInfo") Dim CustomInfo As String = ReadIni(Path & "PCL\Setup.ini", "CustomInfo")
If CustomInfo = "" Then Info = If(CustomInfo <> "", CustomInfo, GetDefaultDescription())
Select Case State
Case McVersionState.Snapshot
If Version.McName.ContainsF("pre", True) Then
Info = "预发布版 " & Version.McName
ElseIf Version.McName.ContainsF("rc", True) Then
Info = "发布候选 " & Version.McName
ElseIf Version.McName.Contains("experimental") OrElse Version.McName = "pending" Then
Info = "实验性快照"
Else
Info = "快照 " & Version.McName
End If
Case McVersionState.Old
Info = "远古版本"
Case McVersionState.Original, McVersionState.Forge, McVersionState.NeoForge, McVersionState.Fabric, McVersionState.OptiFine, McVersionState.LiteLoader
Info = Version.ToString
Case McVersionState.Fool
Info = GetMcFoolName(Version.McName)
Case McVersionState.Error
'已有错误信息
Case Else
Info = "发生了未知错误,请向作者反馈此问题"
End Select
If Not State = McVersionState.Error Then
If HasJumpLoader Then Info += ", JumpLoader"
If Setup.Get("VersionServerLogin", Version:=Me) = 3 Then Info += ", 统一通行证验证"
If Setup.Get("VersionServerLogin", Version:=Me) = 4 Then Info += ", Authlib 验证"
End If
Else
Info = CustomInfo
End If
'确定版本收藏状态 '确定版本收藏状态
IsStar = ReadIni(Path & "PCL\Setup.ini", "IsStar", False) IsStar = ReadIni(Path & "PCL\Setup.ini", "IsStar", False)
'确定版本显示种类 '确定版本显示种类
@@ -838,6 +831,41 @@ ExitDataLoad:
End Try End Try
Return Me Return Me
End Function End Function
''' <summary>
''' 获取版本的默认描述。
''' </summary>
Public Function GetDefaultDescription() As String
Dim Info As String = ""
Select Case State
Case McVersionState.Snapshot
If Version.McName.ContainsF("pre", True) Then
Info = "预发布版 " & Version.McName
ElseIf Version.McName.ContainsF("rc", True) Then
Info = "发布候选 " & Version.McName
ElseIf Version.McName.Contains("experimental") OrElse Version.McName = "pending" Then
Info = "实验性快照"
Else
Info = "快照 " & Version.McName
End If
Case McVersionState.Old
Info = "远古版本"
Case McVersionState.Original, McVersionState.Forge, McVersionState.NeoForge, McVersionState.Fabric, McVersionState.OptiFine, McVersionState.LiteLoader
Info = Version.ToString
Case McVersionState.Fool
Info = GetMcFoolName(Version.McName)
Case McVersionState.Error
Return Me.Info '已有错误信息
Case Else
Info = "发生了未知错误,请向作者反馈此问题"
End Select
If Not State = McVersionState.Error Then
If HasJumpLoader Then Info += ", JumpLoader"
If Setup.Get("VersionServerLogin", Version:=Me) = 3 Then Info += ", 统一通行证验证"
If Setup.Get("VersionServerLogin", Version:=Me) = 4 Then Info += ", Authlib 验证"
End If
Return Info
End Function
Public IsLoaded As Boolean = False Public IsLoaded As Boolean = False
Public Overrides Function Equals(obj As Object) As Boolean Public Overrides Function Equals(obj As Object) As Boolean
@@ -1030,21 +1058,23 @@ ExitDataLoad:
Public Function GetMcFoolName(Name As String) As String Public Function GetMcFoolName(Name As String) As String
Name = Name.ToLower Name = Name.ToLower
If Name.StartsWithF("2.0") Then If Name.StartsWithF("2.0") Then
Return "这个秘密计划了两年的更新将游戏推向了一个新高度!" Return "2013 | 这个秘密计划了两年的更新将游戏推向了一个新高度!"
ElseIf Name.StartsWithF("20w14inf") OrElse Name = "20w14∞" Then
Return "我们加入了 20 亿个新的维度,让无限的想象变成了现实!"
ElseIf Name = "15w14a" Then ElseIf Name = "15w14a" Then
Return "作为一款全年龄向的游戏,我们需要和平,需要爱与拥抱。" Return "2015 | 作为一款全年龄向的游戏,我们需要和平,需要爱与拥抱。"
ElseIf Name = "1.rv-pre1" Then ElseIf Name = "1.rv-pre1" Then
Return "是时候将现代科技带入 Minecraft 了!" Return "2016 | 是时候将现代科技带入 Minecraft 了!"
ElseIf Name = "3d shareware v1.34" Then ElseIf Name = "3d shareware v1.34" Then
Return "我们从地下室的废墟里找到了这个开发于 1994 年的杰作!" Return "2019 | 我们从地下室的废墟里找到了这个开发于 1994 年的杰作!"
ElseIf Name.StartsWithF("20w14inf") OrElse Name = "20w14∞" Then
Return "2020 | 我们加入了 20 亿个新的维度,让无限的想象变成了现实!"
ElseIf Name = "22w13oneblockatatime" Then ElseIf Name = "22w13oneblockatatime" Then
Return "一次一个方块更新!迎接全新的挖掘、合成与骑乘玩法吧!" Return "2022 | 一次一个方块更新!迎接全新的挖掘、合成与骑乘玩法吧!"
ElseIf Name = "23w13a_or_b" Then ElseIf Name = "23w13a_or_b" Then
Return "研究表明:玩家喜欢作出选择——越多越好!" Return "2023 | 研究表明:玩家喜欢作出选择——越多越好!"
ElseIf Name = "24w14potato" Then ElseIf Name = "24w14potato" Then
Return "毒马铃薯一直都被大家忽视和低估,于是我们超级加强了它!" Return "2024 | 毒马铃薯一直都被大家忽视和低估,于是我们超级加强了它!"
ElseIf Name = "25w14craftmine" Then
Return "2025 | 你可以合成任何东西——包括合成你的世界!"
Else Else
Return "" Return ""
End If End If
@@ -1095,7 +1125,7 @@ ExitDataLoad:
Throw New Exception("无法读取版本文件夹,可能是由于没有权限(" & Path & "versions)", ex) Throw New Exception("无法读取版本文件夹,可能是由于没有权限(" & Path & "versions)", ex)
End Try End Try
End If End If
'没有可用版本 '不可用
If Not FolderList.Any() Then If Not FolderList.Any() Then
WriteIni(Path & "PCL.ini", "VersionCache", "") '清空缓存 WriteIni(Path & "PCL.ini", "VersionCache", "") '清空缓存
GoTo OnLoaded GoTo OnLoaded
@@ -1119,10 +1149,10 @@ Reload:
McVersionList = McVersionListLoadNoCache(Path) McVersionList = McVersionListLoadNoCache(Path)
End If End If
IsFirstMcVersionListLoad = False IsFirstMcVersionListLoad = False
If Loader.IsAborted Then Exit Sub
'改变当前选择的版本 '改变当前选择的版本
OnLoaded: OnLoaded:
If Loader.IsAborted Then Exit Sub
If McVersionList.Any(Function(v) v.Key <> McVersionCardType.Error) Then If McVersionList.Any(Function(v) v.Key <> McVersionCardType.Error) Then
'尝试读取已储存的选择 '尝试读取已储存的选择
Dim SavedSelection As String = ReadIni(Path & "PCL.ini", "Version") Dim SavedSelection As String = ReadIni(Path & "PCL.ini", "Version")
@@ -1252,9 +1282,8 @@ OnLoaded:
Dim VersionList As New List(Of McVersion) Dim VersionList As New List(Of McVersion)
#Region "循环加载每个版本的信息" #Region "循环加载每个版本的信息"
Dim Dirs As DirectoryInfo() = New DirectoryInfo(Path & "versions").GetDirectories For Each Folder As DirectoryInfo In New DirectoryInfo(Path & "versions").GetDirectories
For Each Folder As DirectoryInfo In Dirs If Not Folder.Exists OrElse Not Folder.EnumerateFiles.Any Then
If Not Folder.EnumerateFiles.Any Then
Log("[Minecraft] 跳过空文件夹:" & Folder.FullName) Log("[Minecraft] 跳过空文件夹:" & Folder.FullName)
Continue For Continue For
End If End If
@@ -1288,8 +1317,11 @@ OnLoaded:
'单独列出收藏的版本 '单独列出收藏的版本
Dim StaredVersions As New List(Of McVersion) Dim StaredVersions As New List(Of McVersion)
For Each Version As McVersion In VersionList For Each Version As McVersion In VersionList.ToList
If Version.IsStar AndAlso Not Version.DisplayType = McVersionCardType.Hidden Then StaredVersions.Add(Version) If Version.IsStar AndAlso Not Version.DisplayType = McVersionCardType.Hidden Then
StaredVersions.Add(Version)
VersionList.Remove(Version)
End If
Next Next
If StaredVersions.Any Then VersionListOriginal.Add(McVersionCardType.Star, StaredVersions) If StaredVersions.Any Then VersionListOriginal.Add(McVersionCardType.Star, StaredVersions)
@@ -1404,7 +1436,7 @@ OnLoaded:
Next Next
If Not IsNothing(Snapshot) Then OldList.Remove(Snapshot) If Not IsNothing(Snapshot) Then OldList.Remove(Snapshot)
'按版本号排序 '按版本号排序
Dim NewList As List(Of McVersion) = Sort(OldList, Function(Left, Right) Left.Version.McCodeMain > Right.Version.McCodeMain) Dim NewList As List(Of McVersion) = OldList.OrderByDescending(Function(v) v.Version.McCodeMain).ToList
'回设 '回设
If Not IsNothing(Snapshot) Then NewList.Insert(0, Snapshot) If Not IsNothing(Snapshot) Then NewList.Insert(0, Snapshot)
ResultVersionList(McVersionCardType.OriginalLike) = NewList ResultVersionList(McVersionCardType.OriginalLike) = NewList
@@ -1412,7 +1444,7 @@ OnLoaded:
'不常用版本:按发布时间新旧排序,如果不可用则按名称排序 '不常用版本:按发布时间新旧排序,如果不可用则按名称排序
If ResultVersionList.ContainsKey(McVersionCardType.Rubbish) Then If ResultVersionList.ContainsKey(McVersionCardType.Rubbish) Then
ResultVersionList(McVersionCardType.Rubbish) = Sort(ResultVersionList(McVersionCardType.Rubbish), ResultVersionList(McVersionCardType.Rubbish) = ResultVersionList(McVersionCardType.Rubbish).Sort(
Function(Left As McVersion, Right As McVersion) Function(Left As McVersion, Right As McVersion)
Dim LeftYear As Integer = Left.ReleaseTime.Year '+ If(Left.State = McVersionState.Original OrElse Left.Version.HasOptiFine, 100, 0) Dim LeftYear As Integer = Left.ReleaseTime.Year '+ If(Left.State = McVersionState.Original OrElse Left.Version.HasOptiFine, 100, 0)
Dim RightYear As Integer = Right.ReleaseTime.Year '+ If(Right.State = McVersionState.Original OrElse Left.Version.HasOptiFine, 100, 0) Dim RightYear As Integer = Right.ReleaseTime.Year '+ If(Right.State = McVersionState.Original OrElse Left.Version.HasOptiFine, 100, 0)
@@ -1434,7 +1466,7 @@ OnLoaded:
'API 版本:优先按版本排序,此后【先放 Fabric,再放 Neo/Forge(按版本号从高到低排序),最后放 LiteLoader(按名称排序)】 'API 版本:优先按版本排序,此后【先放 Fabric,再放 Neo/Forge(按版本号从高到低排序),最后放 LiteLoader(按名称排序)】
If ResultVersionList.ContainsKey(McVersionCardType.API) Then If ResultVersionList.ContainsKey(McVersionCardType.API) Then
ResultVersionList(McVersionCardType.API) = Sort(ResultVersionList(McVersionCardType.API), ResultVersionList(McVersionCardType.API) = ResultVersionList(McVersionCardType.API).Sort(
Function(Left As McVersion, Right As McVersion) Function(Left As McVersion, Right As McVersion)
Dim Basic = VersionSortInteger(Left.Version.McName, Right.Version.McName) Dim Basic = VersionSortInteger(Left.Version.McName, Right.Version.McName)
If Basic <> 0 Then If Basic <> 0 Then
@@ -1524,7 +1556,7 @@ OnLoaded:
''' 要求玩家选择一个皮肤文件,并进行相关校验。 ''' 要求玩家选择一个皮肤文件,并进行相关校验。
''' </summary> ''' </summary>
Public Function McSkinSelect() As McSkinInfo Public Function McSkinSelect() As McSkinInfo
Dim FileName As String = SelectFile("皮肤文件(*.png)|*.png", "选择皮肤文件") Dim FileName As String = SelectFile("皮肤文件(*.png;*.jpg;*.webp)|*.png;*.jpg;*.webp", "选择皮肤文件")
'验证有效性 '验证有效性
If FileName = "" Then Return New McSkinInfo With {.IsVaild = False} If FileName = "" Then Return New McSkinInfo With {.IsVaild = False}
@@ -1613,7 +1645,7 @@ OnLoaded:
Dim FileAddress As String = PathTemp & "Cache\Skin\" & GetHash(Address) & ".png" Dim FileAddress As String = PathTemp & "Cache\Skin\" & GetHash(Address) & ".png"
SyncLock McSkinDownloadLock SyncLock McSkinDownloadLock
If Not File.Exists(FileAddress) Then If Not File.Exists(FileAddress) Then
NetDownload(Address, FileAddress & NetDownloadEnd) NetDownloadByClient(Address, FileAddress & NetDownloadEnd)
File.Delete(FileAddress) File.Delete(FileAddress)
FileSystem.Rename(FileAddress & NetDownloadEnd, FileAddress) FileSystem.Rename(FileAddress & NetDownloadEnd, FileAddress)
Log("[Minecraft] 皮肤下载成功:" & FileAddress) Log("[Minecraft] 皮肤下载成功:" & FileAddress)
@@ -1931,7 +1963,7 @@ OnLoaded:
''' <summary> ''' <summary>
''' 获取版本缺失的支持库文件所对应的 NetTaskFile。 ''' 获取版本缺失的支持库文件所对应的 NetTaskFile。
''' </summary> ''' </summary>
Public Function McLibFix(Version As McVersion, Optional CoreJarOnly As Boolean = False) As List(Of NetFile) Public Function McLibFix(Version As McVersion) As List(Of NetFile)
If Not Version.IsLoaded Then Version.Load() '确保例如 JumpLoader 等项被合并入 Json If Not Version.IsLoaded Then Version.Load() '确保例如 JumpLoader 等项被合并入 Json
Dim Result As New List(Of NetFile) Dim Result As New List(Of NetFile)
@@ -1944,88 +1976,99 @@ OnLoaded:
Catch ex As Exception Catch ex As Exception
Log(ex, "版本缺失主 jar 文件所必须的信息", LogLevel.Developer) Log(ex, "版本缺失主 jar 文件所必须的信息", LogLevel.Developer)
End Try End Try
If CoreJarOnly Then Return Result
'是否跳过校验
Dim IsSetupSkip As Boolean = ShouldIgnoreFileCheck(Version)
'Library 文件 'Library 文件
Result.AddRange(McLibFixFromLibToken(McLibListGet(Version, False), JumpLoaderFolder:=Version.PathIndie & ".jumploader\", AllowUnsameFile:=IsSetupSkip)) Result.AddRange(McLibFixFromLibToken(McLibListGet(Version, False), JumpLoaderFolder:=Version.PathIndie & ".jumploader\"))
'统一通行证文件 '统一通行证文件
If Setup.Get("VersionServerLogin", Version:=Version) = 3 Then If Setup.Get("VersionServerLogin", Version:=Version) = 3 Then
Dim TargetFile = PathAppdata & "nide8auth.jar" Dim TargetFile = PathAppdata & "nide8auth.jar"
If Not (IsSetupSkip AndAlso File.Exists(TargetFile)) Then Dim DownloadInfo As JObject = Nothing
Dim DownloadInfo As JObject = Nothing '获取下载信息
'获取下载信息 Try
Try Log("[Minecraft] 开始获取统一通行证下载信息")
Log("[Minecraft] 开始获取统一通行证下载信息") '测试链接:https://auth.mc-user.com:233/00000000000000000000000000000000/
'测试链接:https://auth.mc-user.com:233/00000000000000000000000000000000/ DownloadInfo = GetJson(NetGetCodeByLoader({
DownloadInfo = GetJson(NetGetCodeByDownload({
"https://auth.mc-user.com:233/" & Setup.Get("VersionServerNide", Version:=Version)}, IsJson:=True)) "https://auth.mc-user.com:233/" & Setup.Get("VersionServerNide", Version:=Version)}, IsJson:=True))
Catch ex As Exception Catch ex As Exception
Log(ex, "获取统一通行证下载信息失败") Log(ex, "获取统一通行证下载信息失败")
End Try End Try
'校验文件 '校验文件
If DownloadInfo IsNot Nothing Then If DownloadInfo IsNot Nothing Then
Dim Checker As New FileChecker(Hash:=DownloadInfo("jarHash").ToString) Dim Checker As New FileChecker(Hash:=DownloadInfo("jarHash").ToString)
If (IsSetupSkip AndAlso File.Exists(TargetFile)) OrElse Checker.Check(TargetFile) IsNot Nothing Then If Checker.Check(TargetFile) IsNot Nothing Then
'开始下载 '开始下载
Log("[Minecraft] 统一通行证需要更新:Hash - " & Checker.Hash, LogLevel.Developer) Log("[Minecraft] 统一通行证需要更新:Hash - " & Checker.Hash, LogLevel.Developer)
Result.Add(New NetFile({"https://login.mc-user.com:233/index/jar"}, TargetFile, Checker)) Result.Add(New NetFile({"https://login.mc-user.com:233/index/jar"}, TargetFile, Checker))
End If
End If End If
End If End If
End If End If
'Authlib-Injector 文件 'Authlib-Injector 文件
If Setup.Get("VersionServerLogin", Version:=Version) = 4 OrElse If Setup.Get("VersionServerLogin", Version:=Version) = 4 Then
(PageLinkHiper.HiperState = LoadState.Finished AndAlso Setup.Get("LoginType") = McLoginType.Legacy) Then 'HiPer 登录转接 Dim TargetFile = PathPure & "\authlib-injector.jar"
Dim TargetFile = PathAppdata & "authlib-injector.jar" Dim DownloadInfo As JObject = Nothing
If Not (IsSetupSkip AndAlso File.Exists(TargetFile)) Then '获取下载信息
Dim DownloadInfo As JObject = Nothing Try
'获取下载信息 Log("[Minecraft] 开始获取 Authlib-Injector 下载信息")
Try DownloadInfo = GetJson(NetGetCodeByLoader({
Log("[Minecraft] 开始获取 Authlib-Injector 下载信息") "https://authlib-injector.yushi.moe/artifact/latest.json",
DownloadInfo = GetJson(NetGetCodeByDownload({"https://bmclapi2.bangbang93.com/mirrors/authlib-injector/artifact/latest.json"}, IsJson:=True)) "https://bmclapi2.bangbang93.com/mirrors/authlib-injector/artifact/latest.json"
Catch ex As Exception }, IsJson:=True))
Log(ex, "获取 Authlib-Injector 下载信息失败") Catch ex As Exception
End Try Log(ex, "获取 Authlib-Injector 下载信息失败")
'校验文件 End Try
If DownloadInfo IsNot Nothing Then '校验文件
Dim Checker As New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString) If DownloadInfo IsNot Nothing Then
If (IsSetupSkip AndAlso File.Exists(TargetFile)) OrElse Checker.Check(TargetFile) IsNot Nothing Then Dim Checker As New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString)
'开始下载 If Checker.Check(TargetFile) IsNot Nothing Then
Dim DownloadAddress As String = DownloadInfo("download_url") '开始下载
Log("[Minecraft] Authlib-Injector 需要更新:" & DownloadAddress, LogLevel.Developer) Dim DownloadAddress As String = DownloadInfo("download_url").ToString.
Result.Add(New NetFile({DownloadAddress}, TargetFile, New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString))) Replace("bmclapi2.bangbang93.com/mirrors/authlib-injector", "authlib-injector.yushi.moe")
End If Log("[Minecraft] Authlib-Injector 需要更新:" & DownloadAddress, LogLevel.Developer)
Result.Add(New NetFile({
DownloadAddress,
DownloadAddress.Replace("authlib-injector.yushi.moe", "bmclapi2.bangbang93.com/mirrors/authlib-injector")
}, TargetFile, New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString)))
End If End If
End If End If
End If End If
'跳过校验
If ShouldIgnoreFileCheck(Version) Then
Log("[Minecraft] 用户要求尽量忽略文件检查,这可能会保留有误的文件")
Result = Result.Where(
Function(f)
If File.Exists(f.LocalPath) Then
Log("[Minecraft] 跳过下载的支持库文件:" & f.LocalPath, LogLevel.Debug)
Return False
Else
Return True
End If
End Function).ToList
End If
Return Result Return Result
End Function End Function
''' <summary> ''' <summary>
''' 将 McLibToken 列表转换为 NetFile。无需下载的文件会被自动过滤。 ''' 将 McLibToken 列表转换为 NetFile。无需下载的文件会被自动过滤。
''' </summary> ''' </summary>
Public Function McLibFixFromLibToken(Libs As List(Of McLibToken), Optional CustomMcFolder As String = Nothing, Optional JumpLoaderFolder As String = Nothing, Optional AllowUnsameFile As Boolean = False) As List(Of NetFile) Public Function McLibFixFromLibToken(Libs As List(Of McLibToken), Optional CustomMcFolder As String = Nothing, Optional JumpLoaderFolder As String = Nothing) As List(Of NetFile)
CustomMcFolder = If(CustomMcFolder, PathMcFolder) CustomMcFolder = If(CustomMcFolder, PathMcFolder)
Dim Result As New List(Of NetFile) Dim Result As New List(Of NetFile)
'获取 '获取
For Each Token As McLibToken In Libs For Each Token As McLibToken In Libs
'检查文件 '检查文件
Dim Checker As FileChecker Dim Checker As New FileChecker(ActualSize:=If(Token.Size = 0, -1, Token.Size), Hash:=Token.SHA1)
If AllowUnsameFile Then '只要文件存在则通过检查,用于放宽完整性校验的情况
Checker = New FileChecker(MinSize:=1)
Else
Checker = New FileChecker(ActualSize:=If(Token.Size = 0, -1, Token.Size), Hash:=Token.SHA1)
End If
If Checker.Check(Token.LocalPath) Is Nothing Then Continue For If Checker.Check(Token.LocalPath) Is Nothing Then Continue For
'文件不符合,添加下载 '文件不符合,添加下载
Dim Urls As New List(Of String) Dim Urls As New List(Of String)
If Token.Url Is Nothing AndAlso Token.Name = "net.minecraftforge:forge:universal" Then
'特判修复 Forge 部分 universal 文件缺失 URL(#5455)
Token.Url = "https://maven.minecraftforge.net" & Token.LocalPath.Replace(If(Token.IsJumpLoader, JumpLoaderFolder, CustomMcFolder) & "libraries", "").Replace("\", "/")
End If
If Token.Url IsNot Nothing Then If Token.Url IsNot Nothing Then
'获取 Url 的真实地址 '获取 URL 的真实地址
Urls.Add(Token.Url) Urls.Add(Token.Url)
If Token.Url.Contains("launcher.mojang.com/v1/objects") OrElse Token.Url.Contains("client.txt") OrElse If Token.Url.Contains("launcher.mojang.com/v1/objects") OrElse Token.Url.Contains("client.txt") OrElse
Token.Url.Contains(".tsrg") Then Token.Url.Contains(".tsrg") Then
@@ -2067,10 +2110,14 @@ OnLoaded:
McLibGet = If(WithHead, CustomMcFolder & "libraries\", "") & McLibGet = If(WithHead, CustomMcFolder & "libraries\", "") &
Splited(0).Replace(".", "\") & "\" & Splited(1) & "\" & Splited(2) & "\" & Splited(1) & "-" & Splited(2) & ".jar" Splited(0).Replace(".", "\") & "\" & Splited(1) & "\" & Splited(2) & "\" & Splited(1) & "-" & Splited(2) & ".jar"
'判断 OptiFine 是否应该使用 installer '判断 OptiFine 是否应该使用 installer
If McLibGet.Contains("optifine\OptiFine\1.12") AndAlso '仅在 1.12 OptiFine 可重现 If McLibGet.Contains("optifine\OptiFine\1.") AndAlso Splited(2).Split(".").Count > 1 Then
File.Exists(CustomMcFolder & "libraries\" & Splited(0).Replace(".", "\") & "\" & Splited(1) & "\" & Splited(2) & "\" & Splited(1) & "-" & Splited(2) & "-installer.jar") Then Dim MajorVersion As Integer = Val(Splited(2).Split(".")(1).BeforeFirst("_"))
Log("[Launch] 已将 " & Original & " 特判替换为对应的 Installer 文件", LogLevel.Debug) Dim MinorVersion As Integer = If(Splited(2).Split(".").Count > 2, Val(Splited(2).Split(".")(2).BeforeFirst("_")), 0)
McLibGet = McLibGet.Replace(".jar", "-installer.jar") If (MajorVersion = 12 OrElse (MajorVersion = 20 AndAlso MinorVersion >= 4) OrElse MajorVersion >= 21) AndAlso '仅在 1.12 (无法追溯) 和 1.20.4+ (#5376) 遇到此问题
File.Exists($"{CustomMcFolder}libraries\{Splited(0).Replace(".", "\")}\{Splited(1)}\{Splited(2)}\{Splited(1)}-{Splited(2)}-installer.jar") Then
McLaunchLog("已将 " & Original & " 替换为对应的 Installer 文件")
McLibGet = McLibGet.Replace(".jar", "-installer.jar")
End If
End If End If
End Function End Function
@@ -2078,7 +2125,7 @@ OnLoaded:
''' 检查设置,是否应当忽略文件检查? ''' 检查设置,是否应当忽略文件检查?
''' </summary> ''' </summary>
Public Function ShouldIgnoreFileCheck(Version As McVersion) Public Function ShouldIgnoreFileCheck(Version As McVersion)
Return Setup.Get("LaunchAdvanceAssets") OrElse Setup.Get("VersionAdvanceAssetsV2", Version:=Version) OrElse (Setup.Get("VersionAdvanceAssets", Version:=Version) = 2) Return Setup.Get("VersionAdvanceAssetsV2", Version:=Version) OrElse (Setup.Get("VersionAdvanceAssets", Version:=Version) = 2)
End Function End Function
#End Region #End Region
@@ -2159,77 +2206,50 @@ OnLoaded:
''' </summary> ''' </summary>
Public Size As Long Public Size As Long
''' <summary> ''' <summary>
''' 是否为 Virtual 资源文件。
''' </summary>
Public IsVirtual As Boolean
''' <summary>
''' 文件的 Hash 校验码。 ''' 文件的 Hash 校验码。
''' </summary> ''' </summary>
Public Hash As String Public Hash As String
Public Overrides Function ToString() As String Public Overrides Function ToString() As String
Return If(IsVirtual, "[Virtual] ", "") & GetString(Size) & " | " & LocalPath Return GetString(Size) & " | " & LocalPath
End Function End Function
End Structure End Structure
''' <summary> ''' <summary>
''' 获取 Minecraft 的资源文件列表。失败会抛出异常。 ''' 获取 Minecraft 的资源文件列表。失败会抛出异常。
''' </summary> ''' </summary>
''' <param name="Name">版本的资源名称,如“1.13.1”。</param> Private Function McAssetsListGet(Version As McVersion) As List(Of McAssetsToken)
Private Function McAssetsListGet(Name As String) As List(Of McAssetsToken) Dim IndexName = McAssetsGetIndexName(Version)
Try Try
'初始化 '初始化
If Not File.Exists(PathMcFolder & "assets\indexes\" & Name & ".json") Then Throw New FileNotFoundException("Assets 索引文件未找到", PathMcFolder & "assets\indexes\" & Name & ".json") If Not File.Exists($"{PathMcFolder}assets\indexes\{IndexName}.json") Then Throw New FileNotFoundException("未找到 Asset Index", PathMcFolder & "assets\indexes\" & IndexName & ".json")
McAssetsListGet = New List(Of McAssetsToken) Dim Result As New List(Of McAssetsToken)
Dim Json = GetJson(ReadFile(PathMcFolder & "assets\indexes\" & Name & ".json")) Dim Json As JObject = GetJson(ReadFile($"{PathMcFolder}assets\indexes\{IndexName}.json"))
'确认 Virtual 与 Map 状态 '读取列表
Dim IsVirtual As Boolean = False For Each File As JProperty In Json("objects").Children
If Json("virtual") IsNot Nothing AndAlso Json("virtual").ToString Then IsVirtual = True Dim LocalPath As String
If Json("map_to_resources") IsNot Nothing AndAlso Json("map_to_resources").ToString Then If Json("map_to_resources") IsNot Nothing AndAlso Json("map_to_resources").ToObject(Of Boolean) Then
IsVirtual = True 'Remap
'刷新 resources 文件夹符号链接(#2182) LocalPath = Version.PathIndie & "resources\" & File.Name.Replace("/", "\")
'Dim Info As FileSystemInfo = New FileInfo(PathMcFolder & "resources\pack.mcmeta") ElseIf Json("virtual") IsNot Nothing AndAlso Json("virtual").ToObject(Of Boolean) Then
'If Info.Attributes.HasFlag(FileAttributes.ReparsePoint) Then 'Virtual
If Not File.Exists(PathMcFolder & "resources\pack.mcmeta") Then LocalPath = PathMcFolder & "assets\virtual\legacy\" & File.Name.Replace("/", "\")
Log("[Minecraft] 尝试刷新 resources 文件夹符号链接", LogLevel.Debug) Else
Try '正常
DeleteDirectory(PathMcFolder & "resources\", True) LocalPath = PathMcFolder & "assets\objects\" & Left(File.Value("hash").ToString, 2) & "\" & File.Value("hash").ToString
Directory.CreateDirectory(PathMcFolder & "assets\virtual\legacy\")
Dim Result = ShellAndGetOutput("cmd", $"/C mklink /D /J ""{PathMcFolder}resources"" ""{PathMcFolder}assets\virtual\legacy""")
Log($"[Minecraft] 符号链接创建结果:{Result}")
If Not Result.Contains("<<===>>") Then Throw New Exception($"非预期的结果({Result})")
Catch ex As Exception
Log(ex, "创建资源文件夹链接失败,游戏可能会没有声音", LogLevel.Msgbox)
End Try
End If End If
End If Result.Add(New McAssetsToken With {
.LocalPath = LocalPath,
'加载列表 .SourcePath = File.Name,
If IsVirtual Then .Hash = File.Value("hash").ToString,
For Each File As JProperty In Json("objects").Children .Size = File.Value("size").ToString
McAssetsListGet.Add(New McAssetsToken With { })
.IsVirtual = True, Next
.LocalPath = PathMcFolder & "assets\virtual\legacy\" & File.Name.Replace("/", "\"), Return Result
.SourcePath = File.Name,
.Hash = File.Value("hash").ToString,
.Size = File.Value("size").ToString
})
Next
Else
For Each File As JProperty In Json("objects").Children
McAssetsListGet.Add(New McAssetsToken With {
.IsVirtual = False,
.LocalPath = PathMcFolder & "assets\objects\" & Left(File.Value("hash").ToString, 2) & "\" & File.Value("hash").ToString,
.SourcePath = File.Name,
.Hash = File.Value("hash").ToString,
.Size = File.Value("size").ToString
})
Next
End If
Catch ex As Exception Catch ex As Exception
Log(ex, "获取资源文件列表失败:" & Name) Log(ex, "获取资源文件列表失败:" & IndexName)
Throw Throw
End Try End Try
End Function End Function
@@ -2238,12 +2258,12 @@ OnLoaded:
''' <summary> ''' <summary>
''' 获取版本缺失的资源文件所对应的 NetTaskFile。 ''' 获取版本缺失的资源文件所对应的 NetTaskFile。
''' </summary> ''' </summary>
Public Function McAssetsFixList(IndexAddress As String, CheckHash As Boolean, Optional ByRef ProgressFeed As LoaderBase = Nothing) As List(Of NetFile) Public Function McAssetsFixList(Version As McVersion, CheckHash As Boolean, Optional ByRef ProgressFeed As LoaderBase = Nothing) As List(Of NetFile)
Dim Result As New List(Of NetFile) Dim Result As New List(Of NetFile)
Dim AssetsList As List(Of McAssetsToken) Dim AssetsList As List(Of McAssetsToken)
Try Try
AssetsList = McAssetsListGet(IndexAddress) AssetsList = McAssetsListGet(Version)
Dim Token As McAssetsToken Dim Token As McAssetsToken
If ProgressFeed IsNot Nothing Then ProgressFeed.Progress = 0.04 If ProgressFeed IsNot Nothing Then ProgressFeed.Progress = 0.04
For i = 0 To AssetsList.Count - 1 For i = 0 To AssetsList.Count - 1
@@ -2322,8 +2342,8 @@ OnLoaded:
End If End If
Left = Left.ToLowerInvariant Left = Left.ToLowerInvariant
Right = Right.ToLowerInvariant Right = Right.ToLowerInvariant
Dim Lefts = RegexSearch(Left.Replace("快照", "snapshot"), "[a-z]+|[0-9]+") Dim Lefts = RegexSearch(Left.Replace("快照", "snapshot").Replace("预览版", "pre"), "[a-z]+|[0-9]+")
Dim Rights = RegexSearch(Right.Replace("快照", "snapshot"), "[a-z]+|[0-9]+") Dim Rights = RegexSearch(Right.Replace("快照", "snapshot").Replace("预览版", "pre"), "[a-z]+|[0-9]+")
Dim i As Integer = 0 Dim i As Integer = 0
While True While True
'两边均缺失,感觉是一个东西 '两边均缺失,感觉是一个东西
@@ -2372,15 +2392,11 @@ NextEntry:
''' <summary> ''' <summary>
''' 比较两个版本名的排序器。 ''' 比较两个版本名的排序器。
''' </summary> ''' </summary>
Public Class VersionSorter Public Class VersionComparer
Implements IComparer(Of String) Implements IComparer(Of String)
Public IsDecreased As Boolean = True
Public Function Compare(x As String, y As String) As Integer Implements IComparer(Of String).Compare Public Function Compare(x As String, y As String) As Integer Implements IComparer(Of String).Compare
Return VersionSortInteger(x, y) * If(IsDecreased, -1, 1) Return VersionSortInteger(x, y)
End Function End Function
Public Sub New(Optional IsDecreased As Boolean = True)
Me.IsDecreased = IsDecreased
End Sub
End Class End Class
''' <summary> ''' <summary>
@@ -1,6 +1,7 @@
Imports System.IO.Compression Imports System.IO.Compression
Public Module ModMod Public Module ModMod
Private Const LocalModCacheVersion As Integer = 7
Public Class McMod Public Class McMod
@@ -47,7 +48,7 @@ Public Module ModMod
Get Get
Load() Load()
If Not IsFileAvailable Then If Not IsFileAvailable Then
Return McModState.Unavaliable Return McModState.Unavailable
ElseIf Path.EndsWithF(".disabled", True) OrElse Path.EndsWithF(".old", True) Then ElseIf Path.EndsWithF(".disabled", True) OrElse Path.EndsWithF(".old", True) Then
Return McModState.Disabled Return McModState.Disabled
Else Else
@@ -58,7 +59,7 @@ Public Module ModMod
Public Enum McModState As Integer Public Enum McModState As Integer
Fine = 0 Fine = 0
Disabled = 1 Disabled = 1
Unavaliable = 2 Unavailable = 2
End Enum End Enum
#End Region #End Region
@@ -687,7 +688,7 @@ Finished:
''' </summary> ''' </summary>
Public ReadOnly Property CanUpdate As Boolean Public ReadOnly Property CanUpdate As Boolean
Get Get
Return ChangelogUrls.Any() Return Not Setup.Get("UiHiddenFunctionModUpdate") AndAlso ChangelogUrls.Any()
End Get End Get
End Property End Property
@@ -701,7 +702,7 @@ Finished:
Dim Info As New FileInfo(Path) Dim Info As New FileInfo(Path)
Dim CacheKey As String = GetHash($"{RawPath}-{Info.LastWriteTime.ToLongTimeString}-{Info.Length}-C") Dim CacheKey As String = GetHash($"{RawPath}-{Info.LastWriteTime.ToLongTimeString}-{Info.Length}-C")
Dim Cached As String = ReadIni(PathTemp & "Cache\ModHash.ini", CacheKey) Dim Cached As String = ReadIni(PathTemp & "Cache\ModHash.ini", CacheKey)
If Cached <> "" Then If Cached <> "" AndAlso RegexCheck(Cached, "^\d+$") Then '#5062
_CurseForgeHash = Cached _CurseForgeHash = Cached
Return _CurseForgeHash Return _CurseForgeHash
End If End If
@@ -814,7 +815,7 @@ Finished:
'等待 Mod 更新完成 '等待 Mod 更新完成
If PageVersionMod.UpdatingVersions.Contains(Loader.Input) Then If PageVersionMod.UpdatingVersions.Contains(Loader.Input) Then
Log($"[Mod] 等待 Mod 更新完成后才能继续加载 Mod 列表") Log($"[Mod] 等待 Mod 更新完成后才能继续加载 Mod 列表:" & Loader.Input)
Try Try
RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.Text = "正在更新 Mod") RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.Text = "正在更新 Mod")
Do Until Not PageVersionMod.UpdatingVersions.Contains(Loader.Input) Do Until Not PageVersionMod.UpdatingVersions.Contains(Loader.Input)
@@ -824,6 +825,7 @@ Finished:
Finally Finally
RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.Text = "正在加载 Mod 列表") RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.Text = "正在加载 Mod 列表")
End Try End Try
FrmVersionMod.LoaderRun(LoaderFolderRunType.UpdateOnly)
End If End If
'获取 Mod 文件夹下的可用文件列表 '获取 Mod 文件夹下的可用文件列表
@@ -852,7 +854,7 @@ Finished:
Dim Cache As New JObject Dim Cache As New JObject
Try Try
Dim CacheContent As String = ReadFile(CachePath) Dim CacheContent As String = ReadFile(CachePath)
If CacheContent <> "" Then If Not String.IsNullOrWhiteSpace(CacheContent) Then
Cache = GetJson(CacheContent) Cache = GetJson(CacheContent)
If Not Cache.ContainsKey("version") OrElse Cache("version").ToObject(Of Integer) <> LocalModCacheVersion Then If Not Cache.ContainsKey("version") OrElse Cache("version").ToObject(Of Integer) <> LocalModCacheVersion Then
Log($"[Mod] 本地 Mod 信息缓存版本已过期,将弃用这些缓存信息", LogLevel.Debug) Log($"[Mod] 本地 Mod 信息缓存版本已过期,将弃用这些缓存信息", LogLevel.Debug)
@@ -861,6 +863,7 @@ Finished:
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "读取本地 Mod 信息缓存失败,已重置") Log(ex, "读取本地 Mod 信息缓存失败,已重置")
Cache = New JObject
End Try End Try
Cache("version") = LocalModCacheVersion Cache("version") = LocalModCacheVersion
@@ -886,7 +889,7 @@ Finished:
End If End If
ModList.Add(ModEntry) ModList.Add(ModEntry)
'读取 Comp 缓存 '读取 Comp 缓存
If ModEntry.State = McMod.McModState.Unavaliable Then Continue For If ModEntry.State = McMod.McModState.Unavailable Then Continue For
Dim CacheKey = ModEntry.ModrinthHash & PageVersionLeft.Version.Version.McName & GetTargetModLoaders().Join("") Dim CacheKey = ModEntry.ModrinthHash & PageVersionLeft.Version.Version.McName & GetTargetModLoaders().Join("")
If Cache.ContainsKey(CacheKey) Then If Cache.ContainsKey(CacheKey) Then
ModEntry.FromJson(Cache(CacheKey)) ModEntry.FromJson(Cache(CacheKey))
@@ -899,10 +902,10 @@ Finished:
Log($"[Mod] 共有 {ModList.Count} 个 Mod,其中 {ModUpdateList.Where(Function(m) m.Comp Is Nothing).Count} 个需要联网获取信息,{ModUpdateList.Where(Function(m) m.Comp IsNot Nothing).Count} 个需要更新信息") Log($"[Mod] 共有 {ModList.Count} 个 Mod,其中 {ModUpdateList.Where(Function(m) m.Comp Is Nothing).Count} 个需要联网获取信息,{ModUpdateList.Where(Function(m) m.Comp IsNot Nothing).Count} 个需要更新信息")
'排序 '排序
ModList = Sort(ModList, ModList = ModList.Sort(
Function(Left As McMod, Right As McMod) As Boolean Function(Left As McMod, Right As McMod) As Boolean
If (Left.State = McMod.McModState.Unavaliable) <> (Right.State = McMod.McModState.Unavaliable) Then If (Left.State = McMod.McModState.Unavailable) <> (Right.State = McMod.McModState.Unavailable) Then
Return Left.State = McMod.McModState.Unavaliable Return Left.State = McMod.McModState.Unavailable
Else Else
Return Not Right.FileName.CompareTo(Left.FileName) Return Not Right.FileName.CompareTo(Left.FileName)
End If End If
@@ -924,27 +927,18 @@ Finished:
End Try End Try
End Sub End Sub
'联网加载 Mod 详情 '联网加载 Mod 详情
Private Const LocalModCacheVersion As Integer = 6
Public McModDetailLoader As New LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer)("Mod List Detail Loader", AddressOf McModDetailLoad) Public McModDetailLoader As New LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer)("Mod List Detail Loader", AddressOf McModDetailLoad)
Private Sub McModDetailLoad(Loader As LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer)) Private Sub McModDetailLoad(Loader As LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer))
Dim Mods As List(Of McMod) = Loader.Input.Key Dim Mods As List(Of McMod) = Loader.Input.Key
Dim Cache As JObject = Loader.Input.Value Dim Cache As JObject = Loader.Input.Value
'获取作为检查目标的加载器和版本 '获取作为检查目标的加载器和版本
'此处不应向下扩展检查的 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 McVersionInfo = PageVersionLeft.Version.Version
Dim ModLoaders = GetTargetModLoaders() Dim ModLoaders = GetTargetModLoaders()
Dim McVersion = TargetMcVersion.McName Dim McVersion = TargetMcVersion.McName
'暂不向下扩展检查的 MC 小版本
'例如:Mod 在更新 1.16.5 后,对早期的 1.16.2 版本发布了修补补丁,这会导致 PCL 将 1.16.5 版本的 Mod 降级到 1.16.2
'If TargetMcVersion.McCodeMain > 0 AndAlso TargetMcVersion.McCodeMain < 99 Then
' McVersions.Add($"1.{TargetMcVersion.McCodeMain}")
' For i = 1 To TargetMcVersion.McCodeSub
' McVersions.Add($"1.{TargetMcVersion.McCodeMain}.{i}")
' Next
'End If
'McVersions = McVersions.Distinct().ToList()
'开始网络获取 '开始网络获取
Log($"[Mod] 目标加载器:{ModLoaders.Join("/")},版本:{McVersion}") Log($"[Mod] 目标加载器:{ModLoaders.Join("/")},版本:{McVersion}")
Dim EndedThreadCount As Integer = 0, SucceedThreadCount As Integer = 0 Dim EndedThreadCount As Integer = 0, IsFailed As Boolean = False
Dim MainThread As Thread = Thread.CurrentThread Dim MainThread As Thread = Thread.CurrentThread
'从 Modrinth 获取信息 '从 Modrinth 获取信息
RunInNewThread( RunInNewThread(
@@ -979,7 +973,6 @@ Finished:
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)
If Entry.Comp IsNot Nothing AndAlso Entry.Comp.FromCurseForge Then Project.LogoUrl = Entry.Comp.LogoUrl 'Modrinth 的部分 Logo 不是图片,如果可能,使用 CurseForge 的 Logo
Entry.Comp = Project Entry.Comp = Project
Next Next
Next Next
@@ -1005,9 +998,9 @@ Finished:
End If End If
Next Next
Log($"[Mod] 从 Modrinth 获取本地 Mod 信息结束") Log($"[Mod] 从 Modrinth 获取本地 Mod 信息结束")
SucceedThreadCount += 1
Catch ex As Exception Catch ex As Exception
Log(ex, "从 Modrinth 获取本地 Mod 信息失败") Log(ex, "从 Modrinth 获取本地 Mod 信息失败")
IsFailed = True
Finally Finally
EndedThreadCount += 1 EndedThreadCount += 1
End Try End Try
@@ -1023,7 +1016,7 @@ Finished:
If Loader.IsAbortedWithThread(MainThread) Then Exit Sub If Loader.IsAbortedWithThread(MainThread) Then Exit Sub
Next Next
Dim CurseForgeRaw = CType(CType(GetJson(DlModRequest("https://api.curseforge.com/v1/fingerprints/432", "POST", Dim CurseForgeRaw = CType(CType(GetJson(DlModRequest("https://api.curseforge.com/v1/fingerprints/432", "POST",
$"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer) $"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer)
Log($"[Mod] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息") Log($"[Mod] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息")
'步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系 '步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
If Not CurseForgeRaw.Any() Then Exit Sub If Not CurseForgeRaw.Any() Then Exit Sub
@@ -1046,7 +1039,7 @@ Finished:
'步骤 3:获取工程信息 '步骤 3:获取工程信息
If Not CurseForgeMapping.Any() Then Exit Sub If Not CurseForgeMapping.Any() Then Exit Sub
Dim CurseForgeProject = CType(GetJson(DlModRequest("https://api.curseforge.com/v1/mods", "POST", Dim CurseForgeProject = CType(GetJson(DlModRequest("https://api.curseforge.com/v1/mods", "POST",
$"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")), JObject)("data") $"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")), JObject)("data")
Dim UpdateFileIds As New Dictionary(Of Integer, List(Of McMod)) 'FileId -> 本地 Mod 文件列表 Dim UpdateFileIds As New Dictionary(Of Integer, List(Of McMod)) 'FileId -> 本地 Mod 文件列表
Dim FileIdToProjectSlug As New Dictionary(Of Integer, String) Dim FileIdToProjectSlug As New Dictionary(Of Integer, String)
For Each ProjectJson In CurseForgeProject For Each ProjectJson In CurseForgeProject
@@ -1055,21 +1048,19 @@ Finished:
Dim Project As New CompProject(ProjectJson) Dim Project As New CompProject(ProjectJson)
For Each Entry In CurseForgeMapping(Project.Id) '倒查防止 CurseForge 返回的内容有漏 For Each Entry In CurseForgeMapping(Project.Id) '倒查防止 CurseForge 返回的内容有漏
If Entry.Comp IsNot Nothing AndAlso Not Entry.Comp.FromCurseForge Then If Entry.Comp IsNot Nothing AndAlso Not Entry.Comp.FromCurseForge Then
Entry.Comp.LogoUrl = Project.LogoUrl 'Modrinth 部分 Logo 加载不出来
Entry.Comp = Entry.Comp '再次触发修改事件 Entry.Comp = Entry.Comp '再次触发修改事件
Continue For Continue For
End If End If
Entry.Comp = Project Entry.Comp = Project
Next Next
'查找或许版本更新的文件列表 '查找或许版本更新的文件列表
If ModLoaders.Count = 1 Then 'TODO: 结果有多个 ModLoader 时提示无法检测更新 If ModLoaders.Count = 1 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 Not IndexEntry("modLoader").HasValues OrElse '镜像源会返回一个值为 null 的键 If IndexEntry("modLoader") Is Nothing OrElse ModLoaders.Single <> IndexEntry("modLoader").ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配
ModLoaders.Single <> IndexEntry("modLoader").ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配
Dim IndexVersion As String = IndexEntry("gameVersion") Dim IndexVersion As String = IndexEntry("gameVersion")
If McVersion <> IndexVersion Then Continue For 'MC 版本匹配 If IndexVersion <> McVersion 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 VersionSortInteger(NewestVersion, IndexVersion) > -1 Then Continue For '只保留最新 MC 版本
If NewestVersion <> IndexVersion Then If NewestVersion <> IndexVersion Then
@@ -1114,9 +1105,9 @@ Finished:
End If End If
Next Next
Log($"[Mod] 从 CurseForge 获取 Mod 更新信息结束") Log($"[Mod] 从 CurseForge 获取 Mod 更新信息结束")
SucceedThreadCount += 1
Catch ex As Exception Catch ex As Exception
Log(ex, "从 CurseForge 获取本地 Mod 信息失败") Log(ex, "从 CurseForge 获取本地 Mod 信息失败")
IsFailed = True
Finally Finally
EndedThreadCount += 1 EndedThreadCount += 1
End Try End Try
@@ -1131,14 +1122,14 @@ Finished:
Log($"[Mod] 联网获取本地 Mod 信息完成,为 {Mods.Count} 个 Mod 更新缓存") Log($"[Mod] 联网获取本地 Mod 信息完成,为 {Mods.Count} 个 Mod 更新缓存")
If Not Mods.Any() Then Exit Sub If Not Mods.Any() Then Exit Sub
For Each Entry In Mods For Each Entry In Mods
Entry.CompLoaded = SucceedThreadCount = 2 Entry.CompLoaded = Not IsFailed
Cache(Entry.ModrinthHash & McVersion & ModLoaders.Join("")) = Entry.ToJson() Cache(Entry.ModrinthHash & McVersion & ModLoaders.Join("")) = Entry.ToJson()
Next Next
WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None))) WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
'刷新边栏 '刷新边栏
RunInUi(Sub() FrmVersionMod?.RefreshBars()) RunInUi(Sub() FrmVersionMod?.RefreshBars())
End Sub End Sub
Private 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 PageVersionLeft.Version.Version.HasForge Then ModLoaders.Add(CompModLoaderType.Forge)
If PageVersionLeft.Version.Version.HasNeoForge Then ModLoaders.Add(CompModLoaderType.NeoForge) If PageVersionLeft.Version.Version.HasNeoForge Then ModLoaders.Add(CompModLoaderType.NeoForge)
@@ -9,21 +9,33 @@ Public Module ModModpack
Public Sub ModpackInstall() Public Sub ModpackInstall()
Dim File As String = SelectFile("整合包文件(*.rar;*.zip;*.mrpack)|*.rar;*.zip;*.mrpack", "选择整合包压缩文件") '选择整合包文件 Dim File As String = SelectFile("整合包文件(*.rar;*.zip;*.mrpack)|*.rar;*.zip;*.mrpack", "选择整合包压缩文件") '选择整合包文件
If String.IsNullOrEmpty(File) Then Exit Sub If String.IsNullOrEmpty(File) Then Exit Sub
RunInThread(Sub() ModpackInstall(File)) RunInThread(
Sub()
Try
ModpackInstall(File)
Catch ex As CancelledException
Catch ex As Exception
Log(ex, "手动安装整合包失败", LogLevel.Msgbox)
End Try
End Sub)
End Sub End Sub
''' <summary> ''' <summary>
''' 安装一个给定的整合包文件,返回启动的安装加载器,如果未成功启动则返回 Nothing。 ''' 构建并启动安装给定的整合包文件的加载器,并返回该加载器。若失败则抛出异常。
''' 必须在工作线程执行。 ''' 必须在工作线程执行。
''' </summary> ''' </summary>
Public Function ModpackInstall(File As String, Optional VersionName As String = Nothing, Optional ShowHint As Boolean = True, Optional Logo As String = Nothing) As LoaderCombo(Of String) ''' <exception cref="CancelledException" />
Public Function ModpackInstall(File As String, Optional VersionName 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}\"
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("游戏路径中不能含有感叹号或分号:" & TargetFolder, HintType.Critical) : Throw New CancelledException
'获取整合包种类与关键 Json '获取整合包种类与关键 Json
Dim PackType As Integer = -1 Dim PackType As Integer = -1
Try Try
Archive = New ZipArchive(New FileStream(File, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)) Archive = New ZipArchive(New FileStream(File, FileMode.Open, FileAccess.Read, FileShare.Read))
'从根目录判断整合包类型 '从根目录判断整合包类型
If Archive.GetEntry("mcbbs.packmeta") IsNot Nothing Then PackType = 3 : Exit Try 'MCBBS 整合包(优先于 manifest.json 判断) If Archive.GetEntry("mcbbs.packmeta") IsNot Nothing Then PackType = 3 : Exit Try 'MCBBS 整合包(优先于 manifest.json 判断)
If Archive.GetEntry("mmc-pack.json") IsNot Nothing Then PackType = 2 : Exit Try 'MMC 整合包(优先于 manifest.json 判断,#4194) If Archive.GetEntry("mmc-pack.json") IsNot Nothing Then PackType = 2 : Exit Try 'MMC 整合包(优先于 manifest.json 判断,#4194)
@@ -37,11 +49,11 @@ Public Module ModModpack
End If End If
End If End If
If Archive.GetEntry("modpack.json") IsNot Nothing Then PackType = 1 : Exit Try 'HMCL 整合包 If Archive.GetEntry("modpack.json") IsNot Nothing Then PackType = 1 : Exit Try 'HMCL 整合包
If Archive.GetEntry("modpack.zip") IsNot Nothing OrElse Archive.GetEntry("modpack.mrpack") IsNot Nothing Then PackType = 9 : Exit Try '带启动器的压缩包
'从一级目录判断整合包类型 '从一级目录判断整合包类型
For Each Entry In Archive.Entries For Each Entry In Archive.Entries
Dim FullNames As String() = Entry.FullName.Split("/") Dim FullNames As String() = Entry.FullName.Split("/")
ArchiveBaseFolder = FullNames(0) & "/" ArchiveBaseFolder = FullNames(0) & "/"
If Entry.FullName.EndsWithF("/versions/") AndAlso FullNames.Count = 3 Then PackType = 9 : Exit Try '压缩包
'确定为一级目录下 '确定为一级目录下
If FullNames.Count <> 2 Then Continue For If FullNames.Count <> 2 Then Continue For
'判断是否为关键文件 '判断是否为关键文件
@@ -57,17 +69,15 @@ Public Module ModModpack
End If End If
End If End If
If FullNames(1) = "modpack.json" Then PackType = 1 : Exit Try 'HMCL 整合包 If FullNames(1) = "modpack.json" Then PackType = 1 : Exit Try 'HMCL 整合包
If FullNames(1) = "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 GetExceptionDetail(ex, True).Contains("Error.WinIOError") Then
Log(ex, "打开整合包文件失败", If(ShowHint, LogLevel.Hint, LogLevel.Normal)) Throw New Exception("打开整合包文件失败", ex)
Return Nothing
ElseIf File.EndsWithF(".rar", True) Then ElseIf File.EndsWithF(".rar", True) Then
Log(ex, "PCL 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试", If(ShowHint, LogLevel.Hint, LogLevel.Normal)) Throw New Exception("PCL 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试", ex)
Return Nothing
Else Else
Log(ex, "打开整合包文件失败,文件可能损坏或为不支持的压缩包格式", If(ShowHint, LogLevel.Hint, LogLevel.Normal)) Throw New Exception("打开整合包文件失败,文件可能损坏或为不支持的压缩包格式", ex)
Return Nothing
End If End If
End Try End Try
'执行对应的安装方法 '执行对应的安装方法
@@ -88,57 +98,28 @@ Public Module ModModpack
Log("[ModPack] 整合包种类:Modrinth") Log("[ModPack] 整合包种类:Modrinth")
Return InstallPackModrinth(File, Archive, ArchiveBaseFolder, VersionName, Logo) Return InstallPackModrinth(File, Archive, ArchiveBaseFolder, VersionName, Logo)
Case 9 Case 9
Log("[ModPack] 整合包种类:压缩包") Log("[ModPack] 整合包种类:带启动器的压缩包")
Archive.Dispose() Return InstallPackLauncherPack(File, Archive, ArchiveBaseFolder)
Archive = Nothing
Return InstallPackCompress(File, ArchiveBaseFolder)
Case Else Case Else
If ShowHint Then Log("[ModPack] 整合包种类:未能识别,假定为压缩包")
Hint("未能识别该整合包的种类,无法安装!", HintType.Critical) Return InstallPackCompress(File, Archive)
Else
Log("[ModPack] 未能识别该整合包的种类,无法安装!")
End If
Return Nothing
End Select End Select
Catch ex As Exception
Log(ex, "准备安装整合包失败", LogLevel.Feedback)
Return Nothing
Finally Finally
If Archive IsNot Nothing Then Archive.Dispose() If Archive IsNot Nothing Then Archive.Dispose()
End Try End Try
End Function End Function
'整合包缓存清理 Private Sub ExtractModpackFiles(InstallTemp As String, FileAddress As String, Loader As LoaderBase, LoaderProgressDelta As Double)
Private IsInstallCacheCleared As Boolean = False
Private IsInstallCacheClearing As Boolean = False
Private Sub UnpackFiles(InstallTemp As String, FileAddress As String, Loader As LoaderBase)
'清理缓存文件夹
If Not IsInstallCacheCleared Then
IsInstallCacheCleared = True
IsInstallCacheClearing = True
Try
Log("[ModPack] 开始清理整合包安装缓存")
DeleteDirectory(PathTemp & "PackInstall\")
Log("[ModPack] 已清理整合包安装缓存")
Catch ex As Exception
Log(ex, "清理整合包安装缓存失败")
Finally
IsInstallCacheClearing = False
End Try
ElseIf IsInstallCacheClearing Then
'等待另一个整合包安装的清理步骤完成
Do While IsInstallCacheClearing
Thread.Sleep(1)
Loop
End If
'解压文件 '解压文件
Dim RetryCount As Integer = 1 Dim RetryCount As Integer = 1
Dim Encode = Encoding.GetEncoding("GB18030") Dim Encode = Encoding.GetEncoding("GB18030")
Dim InitialProgress = Loader.Progress
Try Try
Retry: Retry:
Loader.Progress = InitialProgress
'完全不知道为啥会出现文件正在被另一进程使用的问题,总之多试试 '完全不知道为啥会出现文件正在被另一进程使用的问题,总之多试试
DeleteDirectory(InstallTemp) DeleteDirectory(InstallTemp)
ExtractFile(FileAddress, InstallTemp, Encode) ExtractFile(FileAddress, InstallTemp, Encode, ProgressIncrementHandler:=Sub(Delta) Loader.Progress += Delta * LoaderProgressDelta)
Catch ex As Exception Catch ex As Exception
Log(ex, "第 " & RetryCount & " 次解压尝试失败") Log(ex, "第 " & RetryCount & " 次解压尝试失败")
If TypeOf ex Is ArgumentException Then If TypeOf ex Is ArgumentException Then
@@ -151,7 +132,7 @@ Retry:
RetryCount += 1 RetryCount += 1
GoTo Retry GoTo Retry
Else Else
Throw Throw New Exception("解压整合包文件失败", ex)
End If End If
End Try End Try
End Sub End Sub
@@ -166,20 +147,18 @@ Retry:
Dim Json As JObject Dim Json As JObject
Try Try
Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open)) Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open))
If Json("minecraft") Is Nothing OrElse Json("minecraft")("version") Is Nothing Then Throw New Exception("整合包未提供 Minecraft 版本信息")
Catch ex As Exception Catch ex As Exception
Log(ex, "CurseForge 整合包安装信息存在问题", LogLevel.Hint) Throw New Exception("CurseForge 整合包安装信息存在问题", ex)
Return Nothing
End Try End Try
If Json("minecraft") Is Nothing OrElse Json("minecraft")("version") Is Nothing Then Throw New Exception("CurseForge 整合包未提供 Minecraft 版本信息")
'获取版本名 '获取版本名
Dim ShowRibble As Boolean = VersionName Is Nothing
If VersionName Is Nothing Then If VersionName Is Nothing Then
VersionName = If(Json("name"), "") VersionName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions") Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(VersionName) <> "" Then VersionName = "" If Validate.Validate(VersionName) <> "" Then VersionName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate}) If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Return Nothing If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
End If End If
'获取 Mod API 版本信息 '获取 Mod API 版本信息
@@ -190,57 +169,44 @@ Retry:
Dim Id As String = If(Entry("id"), "").ToString.ToLower Dim Id As String = If(Entry("id"), "").ToString.ToLower
If Id.StartsWithF("forge-") Then If Id.StartsWithF("forge-") Then
'Forge 指定 'Forge 指定
If Id.Contains("recommended") Then If Id.Contains("recommended") Then Throw New Exception("该整合包版本过老,已不支持进行安装!")
Log("[ModPack] 该整合包版本过老,已不支持进行安装!", LogLevel.Hint) Log("[ModPack] 整合包 Forge 版本:" & Id)
Return Nothing ForgeVersion = Id.Replace("forge-", "")
End If
Try
Log("[ModPack] 整合包 Forge 版本:" & Id)
ForgeVersion = Id.Replace("forge-", "")
Exit For
Catch ex As Exception
Log(ex, "读取整合包 Forge 版本失败:" & Id)
End Try
ElseIf Id.StartsWithF("neoforge-") Then ElseIf Id.StartsWithF("neoforge-") Then
'NeoForge 指定 'NeoForge 指定
Try Log("[ModPack] 整合包 NeoForge 版本:" & Id)
Log("[ModPack] 整合包 NeoForge 版本:" & Id) NeoForgeVersion = Id.Replace("neoforge-", "")
NeoForgeVersion = Id.Replace("neoforge-", "")
Exit For
Catch ex As Exception
Log(ex, "读取整合包 NeoForge 版本失败:" & Id)
End Try
ElseIf Id.StartsWithF("fabric-") Then ElseIf Id.StartsWithF("fabric-") Then
'Fabric 指定 'Fabric 指定
Try Log("[ModPack] 整合包 Fabric 版本:" & Id)
Log("[ModPack] 整合包 Fabric 版本:" & Id) FabricVersion = Id.Replace("fabric-", "")
FabricVersion = Id.Replace("fabric-", "") Else
Exit For Log("[ModPack] 未知 Mod 加载器:" & Id)
Catch ex As Exception
Log(ex, "读取整合包 Fabric 版本失败:" & Id)
End Try
End If End If
Next Next
'解压与配置文件 '解压与配置文件
Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\" Dim InstallTemp As String = RequestTaskTempFolder()
Dim InstallLoaders As New List(Of LoaderBase) Dim InstallLoaders As New List(Of LoaderBase)
Dim OverrideHome As String = If(Json("overrides"), "") Dim OverrideHome As String = If(Json("overrides"), "")
If OverrideHome <> "" Then If OverrideHome <> "" Then
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件", InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer)) Sub(Task As LoaderTask(Of String, Integer))
UnpackFiles(InstallTemp, FileAddress, Task) ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
Task.Progress = 0.5 Task.Progress = 0.6
Dim OverridePath As String = InstallTemp & ArchiveBaseFolder & OverrideHome
'复制结果 '复制结果
If Directory.Exists(OverridePath) Then Log("[ModPack] 整合包 override 目标:" & OverrideHome)
CopyDirectory(OverridePath, PathMcFolder & "versions\" & VersionName) Dim OverrideRoot = InstallTemp & ArchiveBaseFolder & If(OverrideHome = "." OrElse OverrideHome = "./", "", OverrideHome) '#5613
Log($"[ModPack] 整合包 override 复制:{OverridePath} -> {PathMcFolder & "versions\" & VersionName}") If Directory.Exists(OverrideRoot) Then
Dim CopyTarget = $"{PathMcFolder}versions\{VersionName}"
CopyDirectory(OverrideRoot, CopyTarget, Sub(Delta) Task.Progress += Delta * 0.35)
Log($"[ModPack] 整合包 override 复制:{OverrideRoot} -> {CopyTarget}")
Else Else
Log($"[ModPack] 整合包中未找到 override 文件夹:{OverridePath}") Log($"[ModPack] 整合包中未找到 override 文件夹:{OverrideRoot}")
End If End If
Task.Progress = 0.9 Task.Progress = 0.95
'开启版本隔离 '开启版本隔离
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1) WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndie", 1)
WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndieV2", True)
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
End If End If
@@ -262,7 +228,7 @@ Retry:
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 = GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(ModList, ",") & "]}", "application/json"))("data")
'如果文件已被删除,则 API 会跳过那一项 '如果文件已被删除,则 API 会跳过那一项
If ModList.Count > Task.Output.Count Then Throw New Exception("整合包所需要的部分 Mod 版本已被 Mod 作者删除,因此无法完成整合包安装,请联系整合包作者更新整合包中的 Mod 版本") If ModList.Count > Task.Output.Count Then Throw New Exception("整合包中的部分 Mod 版本已被 Mod 作者删除,所以没法继续安装了,请向整合包作者反馈该问题")
End Sub) With {.ProgressWeight = ModList.Count / 10}) '每 10 Mod 需要 1s End Sub) With {.ProgressWeight = ModList.Count / 10}) '每 10 Mod 需要 1s
'构造 NetFile '构造 NetFile
ModDownloadLoaders.Add(New LoaderTask(Of JArray, List(Of NetFile))("构造 Mod 下载信息", ModDownloadLoaders.Add(New LoaderTask(Of JArray, List(Of NetFile))("构造 Mod 下载信息",
@@ -320,7 +286,6 @@ Retry:
.FabricVersion = FabricVersion .FabricVersion = FabricVersion
} }
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True) Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Return Nothing
'构造 Libraries 加载器 '构造 Libraries 加载器
Dim LoadersLib As New List(Of LoaderBase) Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False}) LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
@@ -333,7 +298,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 = $"{PathMcFolder}versions\{VersionName}\"
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")
@@ -342,18 +307,22 @@ Retry:
End If End If
'删除原始整合包文件 '删除原始整合包文件
For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"} For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
If Not Setup.Get("ToolDownloadKeepModpack") AndAlso File.Exists(Target) Then If File.Exists(Target) Then
Log("[ModPack] 根据设置要求删除原始整合包文件:" & Target) Log("[ModPack] 删除原始整合包文件:" & Target)
File.Delete(Target) File.Delete(Target)
End If End If
Next Next
If File.Exists(FileAddress) AndAlso GetFileNameWithoutExtentionFromPath(FileAddress) = "modpack" Then
Log("[ModPack] 删除安装整合包文件:" & FileAddress)
File.Delete(FileAddress)
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 整合包安装:" & VersionName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Critical) Hint("该整合包正在安装中!", HintType.Critical)
Return Nothing Throw New CancelledException
End If End If
'启动 '启动
@@ -361,7 +330,7 @@ Retry:
Loader.Start(Request.TargetVersionFolder) Loader.Start(Request.TargetVersionFolder)
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
If ShowRibble Then FrmMain.BtnExtraDownload.Ribble() RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
Return Loader Return Loader
End Function End Function
@@ -372,11 +341,10 @@ Retry:
Dim Json As JObject Dim Json As JObject
Try Try
Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "modrinth.index.json").Open)) Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "modrinth.index.json").Open))
If Json("dependencies") Is Nothing OrElse Json("dependencies")("minecraft") Is Nothing Then Throw New Exception("整合包未提供 Minecraft 版本信息")
Catch ex As Exception Catch ex As Exception
Log(ex, "整合包安装信息存在问题", LogLevel.Hint) Throw New Exception("Modrinth 整合包安装信息存在问题", ex)
Return Nothing
End Try End Try
If Json("dependencies") Is Nothing OrElse Json("dependencies")("minecraft") Is Nothing Then Throw New Exception("Modrinth 整合包未提供 Minecraft 版本信息")
'获取 Mod API 版本信息 '获取 Mod API 版本信息
Dim MinecraftVersion As String = Nothing Dim MinecraftVersion As String = Nothing
Dim ForgeVersion As String = Nothing Dim ForgeVersion As String = Nothing
@@ -397,41 +365,43 @@ Retry:
Log("[ModPack] 整合包 Fabric 版本:" & FabricVersion) Log("[ModPack] 整合包 Fabric 版本:" & FabricVersion)
Case "quilt-loader" 'eg. 1.0.0 Case "quilt-loader" 'eg. 1.0.0
Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical) Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical)
Return Nothing Throw New CancelledException
Case Else Case Else
Hint($"无法安装整合包,其中出现了未知的 Mod 加载器 {Entry.Value}!", HintType.Critical) Hint($"无法安装整合包,其中出现了未知的 Mod 加载器 {Entry.Value}!", HintType.Critical)
Return Nothing Throw New CancelledException
End Select End Select
Next Next
'获取版本名 '获取版本名
Dim ShowRibble As Boolean = VersionName Is Nothing
If VersionName Is Nothing Then If VersionName Is Nothing Then
VersionName = If(Json("name"), "") VersionName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions") Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(VersionName) <> "" Then VersionName = "" If Validate.Validate(VersionName) <> "" Then VersionName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate}) If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Return Nothing If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
End If End If
'解压和配置文件 '解压和配置文件
Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\" Dim InstallTemp As String = RequestTaskTempFolder()
Dim InstallLoaders As New List(Of LoaderBase) Dim InstallLoaders As New List(Of LoaderBase)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件", InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer)) Sub(Task As LoaderTask(Of String, Integer))
UnpackFiles(InstallTemp, FileAddress, Task) ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
Task.Progress = 0.5 Task.Progress = 0.6
'复制 overrides 文件夹和 client-overrides 文件夹 '复制 overrides 文件夹和 client-overrides 文件夹
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then
CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName) CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName,
Sub(Delta) Task.Progress += Delta * 0.25)
Else Else
Log("[ModPack] 整合包中未找到 override 目录,已跳过") Log("[ModPack] 整合包中未找到 override 目录,已跳过")
End If End If
Task.Progress = 0.8 Task.Progress = 0.85
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "client-overrides") Then If Directory.Exists(InstallTemp & ArchiveBaseFolder & "client-overrides") Then
CopyDirectory(InstallTemp & ArchiveBaseFolder & "client-overrides", PathMcFolder & "versions\" & VersionName) CopyDirectory(InstallTemp & ArchiveBaseFolder & "client-overrides", PathMcFolder & "versions\" & VersionName,
Sub(Delta) Task.Progress += Delta * 0.1)
End If End If
Task.Progress = 0.9 Task.Progress = 0.95
'开启版本隔离 '开启版本隔离
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1) WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndie", 1)
WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndieV2", True)
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'获取下载文件列表 '获取下载文件列表
Dim FileList As New List(Of NetFile) Dim FileList As New List(Of NetFile)
@@ -440,7 +410,7 @@ Retry:
If File("env") IsNot Nothing Then If File("env") IsNot Nothing Then
Select Case File("env")("client").ToString Select Case File("env")("client").ToString
Case "optional" Case "optional"
If MyMsgBox("是否要下载整合包中的可选文件 " & GetFileNameFromPath(File("path").ToString) & "?", If MyMsgBox("是否要下载可选文件 " & GetFileNameFromPath(File("path").ToString) & "?",
"下载可选文件", "是", "否") = 2 Then "下载可选文件", "是", "否") = 2 Then
Continue For Continue For
End If End If
@@ -469,7 +439,6 @@ Retry:
.FabricVersion = FabricVersion .FabricVersion = FabricVersion
} }
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True) Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Return Nothing
'构造 Libraries 加载器 '构造 Libraries 加载器
Dim LoadersLib As New List(Of LoaderBase) Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False}) LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
@@ -491,18 +460,22 @@ Retry:
End If End If
'删除原始整合包文件 '删除原始整合包文件
For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"} For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
If Not Setup.Get("ToolDownloadKeepModpack") AndAlso File.Exists(Target) Then If File.Exists(Target) Then
Log("[ModPack] 根据设置要求删除原始整合包文件:" & Target) Log("[ModPack] 删除原始整合包文件:" & Target)
File.Delete(Target) File.Delete(Target)
End If End If
Next Next
If File.Exists(FileAddress) AndAlso GetFileNameWithoutExtentionFromPath(FileAddress) = "modpack" Then
Log("[ModPack] 删除安装整合包文件:" & FileAddress)
File.Delete(FileAddress)
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 整合包安装:{VersionName} "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Critical) Hint("该整合包正在安装中!", HintType.Critical)
Return Nothing Throw New CancelledException
End If End If
'启动 '启动
@@ -510,9 +483,8 @@ Retry:
Loader.Start(Request.TargetVersionFolder) Loader.Start(Request.TargetVersionFolder)
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
If ShowRibble Then FrmMain.BtnExtraDownload.Ribble() RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
Return Loader Return Loader
End Function End Function
'HMCL 'HMCL
@@ -522,44 +494,40 @@ Retry:
Try Try
Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "modpack.json").Open, Encoding.UTF8)) Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "modpack.json").Open, Encoding.UTF8))
Catch ex As Exception Catch ex As Exception
Log(ex, "整合包安装信息存在问题", LogLevel.Hint) Throw New Exception("HMCL 整合包安装信息存在问题", ex)
Return Nothing
End Try End Try
'获取版本名 '获取版本名
Dim VersionName As String = If(Json("name"), "") Dim VersionName As String = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions") Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(VersionName) <> "" Then VersionName = "" If Validate.Validate(VersionName) <> "" Then VersionName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate}) If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Return Nothing If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
'解压与配置文件 '解压与配置文件
Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\" Dim InstallTemp As String = RequestTaskTempFolder()
Dim InstallLoaders As New List(Of LoaderBase) Dim InstallLoaders As New List(Of LoaderBase)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件", InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer)) Sub(Task As LoaderTask(Of String, Integer))
UnpackFiles(InstallTemp, FileAddress, Task) ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
Task.Progress = 0.5 Task.Progress = 0.6
'复制结果 '复制结果
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "minecraft") Then If Directory.Exists(InstallTemp & ArchiveBaseFolder & "minecraft") Then
CopyDirectory(InstallTemp & ArchiveBaseFolder & "minecraft", PathMcFolder & "versions\" & VersionName) CopyDirectory(InstallTemp & ArchiveBaseFolder & "minecraft", PathMcFolder & "versions\" & VersionName, Sub(Delta) Task.Progress += Delta * 0.35)
Else Else
Log("[ModPack] 整合包中未找到 minecraft override 目录,已跳过") Log("[ModPack] 整合包中未找到 minecraft override 目录,已跳过")
End If End If
Task.Progress = 0.9 Task.Progress = 0.95
'开启版本隔离 '开启版本隔离
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1) WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndie", 1)
WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndieV2", True)
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 If Json("gameVersion") Is Nothing Then Throw New Exception("该 HMCL 整合包未提供游戏版本信息,无法安装!")
Hint("该整合包未提供游戏版本信息,无法安装!", HintType.Critical)
Return Nothing
End If
Dim Request As New McInstallRequest With { Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName, .TargetVersionName = VersionName,
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\", .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
.MinecraftName = Json("gameVersion").ToString .MinecraftName = Json("gameVersion").ToString
} }
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True) Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Return Nothing
'构造 Libraries 加载器(为了使得 Mods 下载结束后再构造,这样才会下载 JumpLoader 文件) '构造 Libraries 加载器(为了使得 Mods 下载结束后再构造,这样才会下载 JumpLoader 文件)
Dim LoadersLib As New List(Of LoaderBase) Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, String)("重命名版本 Json(副加载器)", LoadersLib.Add(New LoaderTask(Of String, String)("重命名版本 Json(副加载器)",
@@ -589,7 +557,7 @@ Retry:
Dim LoaderName As String = "HMCL 整合包安装:" & VersionName & " " Dim LoaderName As String = "HMCL 整合包安装:" & VersionName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Critical) Hint("该整合包正在安装中!", HintType.Critical)
Return Nothing Throw New CancelledException
End If End If
'启动 '启动
@@ -598,7 +566,7 @@ Retry:
Loader.Start(Request.TargetVersionFolder) Loader.Start(Request.TargetVersionFolder)
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble() RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
Return Loader Return Loader
End Function End Function
@@ -610,38 +578,44 @@ Retry:
PackJson = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "mmc-pack.json").Open, Encoding.UTF8)) PackJson = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "mmc-pack.json").Open, Encoding.UTF8))
PackInstance = ReadFile(Archive.GetEntry(ArchiveBaseFolder & "instance.cfg").Open, Encoding.UTF8) PackInstance = ReadFile(Archive.GetEntry(ArchiveBaseFolder & "instance.cfg").Open, Encoding.UTF8)
Catch ex As Exception Catch ex As Exception
Log(ex, "整合包安装信息存在问题", LogLevel.Hint) Throw New Exception("MMC 整合包安装信息存在问题", ex)
Return Nothing
End Try End Try
'获取版本名 '获取版本名
Dim VersionName As String = If(RegexSeek(PackInstance, "(?<=\nname\=)[^\n]+"), "") Dim VersionName As String = If(RegexSeek(PackInstance, "(?<=\nname\=)[^\n]+"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions") Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(VersionName) <> "" Then VersionName = "" If Validate.Validate(VersionName) <> "" Then VersionName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate}) If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Return Nothing If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
'解压、配置设置文件 '解压、配置设置文件
Dim InstallTemp As String = $"{PathTemp}PackInstall\{RandomInteger(0, 100000)}\" Dim InstallTemp As String = RequestTaskTempFolder()
Dim SetupFile As String = $"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini" Dim SetupFile As String = $"{PathMcFolder}versions\{VersionName}\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))
UnpackFiles(InstallTemp, FileAddress, Task) ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
Task.Progress = 0.5 Task.Progress = 0.6
'复制结果 '复制结果
If Directory.Exists(InstallTemp & ArchiveBaseFolder & ".minecraft") Then If Directory.Exists(InstallTemp & ArchiveBaseFolder & ".minecraft") Then
CopyDirectory(InstallTemp & ArchiveBaseFolder & ".minecraft", PathMcFolder & "versions\" & VersionName) CopyDirectory(InstallTemp & ArchiveBaseFolder & ".minecraft", PathMcFolder & "versions\" & VersionName, Sub(Delta) Task.Progress += Delta * 0.35)
Else Else
Log("[ModPack] 整合包中未找到 override .minecraft 目录,已跳过") Log("[ModPack] 整合包中未找到 override .minecraft 目录,已跳过")
End If End If
Task.Progress = 0.9 Task.Progress = 0.95
'开启版本隔离 '开启版本隔离
WriteIni(SetupFile, "VersionArgumentIndie", 1) WriteIni(SetupFile, "VersionArgumentIndie", 1)
WriteIni(SetupFile, "VersionArgumentIndieV2", True)
'读取 MMC 设置文件(#2655) '读取 MMC 设置文件(#2655)
Try Try
Dim MMCSetupFile As String = InstallTemp & ArchiveBaseFolder & "instance.cfg" Dim MMCSetupFile As String = InstallTemp & ArchiveBaseFolder & "instance.cfg"
If File.Exists(MMCSetupFile) Then If File.Exists(MMCSetupFile) Then
'将其中的等号替换为冒号,以符合 ini 文件格式 '将其中的等号替换为冒号,以符合 ini 文件格式
WriteFile(MMCSetupFile, ReadFile(MMCSetupFile).Replace("=", ":")) Dim Lines As New List(Of String)
For Each Line In ReadFile(MMCSetupFile).Split({vbCr, vbLf}, StringSplitOptions.RemoveEmptyEntries)
If Not Line.Contains("=") Then Continue For
Lines.Add(Line.BeforeFirst("=") & ":" & Line.AfterFirst("="))
Next
WriteFile(MMCSetupFile, Join(Lines, 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")
If PreLaunchCommand <> "" Then If PreLaunchCommand <> "" Then
@@ -670,16 +644,25 @@ Retry:
CopyFile($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png", $"{PathMcFolder}versions\{VersionName}\PCL\Logo.png") CopyFile($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png", $"{PathMcFolder}versions\{VersionName}\PCL\Logo.png")
Log($"[ModPack] 迁移 MultiMC 版本独立设置:版本图标({Logo}.png)") Log($"[ModPack] 迁移 MultiMC 版本独立设置:版本图标({Logo}.png)")
End If End If
'JVM 参数
Dim JvmArgs As String = ReadIni(MMCSetupFile, "JvmArgs", "")
If JvmArgs <> "" Then
If ReadIni(MMCSetupFile, "OverrideJavaArgs", False) Then
WriteIni(SetupFile, "VersionAdvanceJvm", JvmArgs)
Log("[ModPack] 迁移 MultiMC 版本独立设置:JVM 参数(覆盖):" & JvmArgs)
Else
JvmArgs += " " & Setup.Get("LaunchAdvanceJvm")
WriteIni(SetupFile, "VersionAdvanceJvm", JvmArgs)
Log("[ModPack] 迁移 MultiMC 版本独立设置:JVM 参数(追加):" & JvmArgs)
End If
End If
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, $"读取 MMC 配置文件失败({InstallTemp}{ArchiveBaseFolder}instance.cfg)") Log(ex, $"读取 MMC 配置文件失败({InstallTemp}{ArchiveBaseFolder}instance.cfg)")
End Try End Try
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 If PackJson("components") Is Nothing Then Throw New Exception("该 MMC 整合包未提供游戏版本信息,无法安装!")
Hint("该整合包未提供游戏版本信息,无法安装!", HintType.Critical)
Return Nothing
End If
Dim Request As New McInstallRequest With {.TargetVersionName = VersionName, .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\"} Dim Request As New McInstallRequest With {.TargetVersionName = VersionName, .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\"}
For Each Component In PackJson("components") For Each Component In PackJson("components")
Select Case If(Component("uid"), "").ToString Select Case If(Component("uid"), "").ToString
@@ -695,12 +678,11 @@ Retry:
Request.FabricVersion = Component("version") Request.FabricVersion = Component("version")
Case "org.quiltmc.quilt-loader" 'eg. 1.0.0 Case "org.quiltmc.quilt-loader" 'eg. 1.0.0
Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical) Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical)
Return Nothing Throw New CancelledException
End Select End Select
Next Next
'构造加载器 '构造加载器
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True) Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Return Nothing
'构造 Libraries 加载器 '构造 Libraries 加载器
Dim LoadersLib As New List(Of LoaderBase) Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False}) LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
@@ -715,7 +697,7 @@ Retry:
Dim LoaderName As String = "MMC 整合包安装:" & VersionName & " " Dim LoaderName As String = "MMC 整合包安装:" & VersionName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Critical) Hint("该整合包正在安装中!", HintType.Critical)
Return Nothing Throw New CancelledException
End If End If
'启动 '启动
@@ -723,7 +705,7 @@ Retry:
Loader.Start(Request.TargetVersionFolder) Loader.Start(Request.TargetVersionFolder)
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble() RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
Return Loader Return Loader
End Function End Function
@@ -736,51 +718,45 @@ Retry:
Dim Entry = If(Archive.GetEntry(ArchiveBaseFolder & "mcbbs.packmeta"), Archive.GetEntry(ArchiveBaseFolder & "manifest.json")) Dim Entry = If(Archive.GetEntry(ArchiveBaseFolder & "mcbbs.packmeta"), Archive.GetEntry(ArchiveBaseFolder & "manifest.json"))
Json = GetJson(ReadFile(Entry.Open, Encoding.UTF8)) Json = GetJson(ReadFile(Entry.Open, Encoding.UTF8))
Catch ex As Exception Catch ex As Exception
Log(ex, "整合包安装信息存在问题", LogLevel.Hint) Throw New Exception("MCBBS 整合包安装信息存在问题", ex)
Return Nothing
End Try End Try
'获取版本名 '获取版本名
Dim ShowRibble As Boolean = VersionName Is Nothing
If VersionName Is Nothing Then If VersionName Is Nothing Then
VersionName = If(Json("name"), "") VersionName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions") Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(VersionName) <> "" Then VersionName = "" If Validate.Validate(VersionName) <> "" Then VersionName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate}) If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Return Nothing If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
End If End If
'解压与配置文件 '解压与配置文件
Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\" Dim InstallTemp As String = RequestTaskTempFolder()
Dim InstallLoaders As New List(Of LoaderBase) Dim InstallLoaders As New List(Of LoaderBase)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件", InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer)) Sub(Task As LoaderTask(Of String, Integer))
UnpackFiles(InstallTemp, FileAddress, Task) ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
Task.Progress = 0.5 Task.Progress = 0.6
'复制结果 '复制结果
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then
CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName) CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName,
Sub(Delta) Task.Progress += 0.35 * Delta)
Else Else
Log("[ModPack] 整合包中未找到 overrides 目录,已跳过") Log("[ModPack] 整合包中未找到 overrides 目录,已跳过")
End If End If
Task.Progress = 0.9 Task.Progress = 0.95
'开启版本隔离 '开启版本隔离
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1) WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndie", 1)
WriteIni($"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini", "VersionArgumentIndieV2", True)
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("addons") Is Nothing Then If Json("addons") Is Nothing Then Throw New Exception("该 MCBBS 整合包未提供游戏版本附加信息,无法安装!")
Hint("该整合包未提供游戏版本附加信息,无法安装!", HintType.Critical)
Return Nothing
End If
Dim Addons As New Dictionary(Of String, String) Dim Addons As New Dictionary(Of String, String)
For Each Entry In Json("addons") For Each Entry In Json("addons")
Addons.Add(Entry("id"), Entry("version")) Addons.Add(Entry("id"), Entry("version"))
Next Next
If Not Addons.ContainsKey("game") Then If Not Addons.ContainsKey("game") Then Throw New Exception("该 MCBBS 整合包未提供游戏版本信息,无法安装!")
Hint("该整合包未提供游戏版本信息,无法安装!", HintType.Critical)
Return Nothing
End If
If Addons.ContainsKey("quilt") Then If Addons.ContainsKey("quilt") Then
Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical) Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical)
Return Nothing Throw New CancelledException
End If End If
Dim Request As New McInstallRequest With { Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName, .TargetVersionName = VersionName,
@@ -792,7 +768,6 @@ Retry:
.FabricVersion = If(Addons.ContainsKey("fabric"), Addons("fabric"), Nothing) .FabricVersion = If(Addons.ContainsKey("fabric"), Addons("fabric"), Nothing)
} }
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True) Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Return Nothing
'构造 Libraries 加载器 '构造 Libraries 加载器
Dim LoadersLib As New List(Of LoaderBase) Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False}) LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
@@ -807,7 +782,7 @@ Retry:
Dim LoaderName As String = "MCBBS 整合包安装:" & VersionName & " " Dim LoaderName As String = "MCBBS 整合包安装:" & VersionName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中!", HintType.Critical) Hint("该整合包正在安装中!", HintType.Critical)
Return Nothing Throw New CancelledException
End If End If
'启动 '启动
@@ -816,31 +791,111 @@ Retry:
Loader.Start(Request.TargetVersionFolder) Loader.Start(Request.TargetVersionFolder)
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
If ShowRibble Then FrmMain.BtnExtraDownload.Ribble() RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
Return Loader
End Function
'带启动器的压缩包
Private Function InstallPackLauncherPack(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
'获取解压路径
MyMsgBox("接下来请选择一个空文件夹,它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
Dim TargetFolder As String = SelectFolder("选择安装目标(必须是一个空文件夹)")
If String.IsNullOrEmpty(TargetFolder) Then Throw New CancelledException
If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标!", HintType.Critical) : Throw New CancelledException
'解压
Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
New LoaderTask(Of String, Integer)("解压压缩包",
Sub(Task As LoaderTask(Of String, Integer))
ExtractModpackFiles(TargetFolder, FileAddress, Task, 0.9)
Thread.Sleep(400) '避免文件争用
'查找解压后的 exe 文件
Dim Launcher As String = Nothing
For Each ExeFile In Directory.GetFiles(TargetFolder, "*.exe", SearchOption.TopDirectoryOnly)
Dim Info = FileVersionInfo.GetVersionInfo(ExeFile)
Log($"[Modpack] 文件 {ExeFile} 的产品名标识为 {Info.ProductName}")
If Info.ProductName = "Plain Craft Launcher" Then
Launcher = ExeFile
Log($"[Modpack] 发现整合包附带的 PCL 启动器:{ExeFile}")
ElseIf (Info.ProductName.ContainsF("Launcher", True) OrElse Info.ProductName.ContainsF("启动", True)) AndAlso
Not Info.ProductName = "Plain Craft Launcher Admin Manager" Then
If Launcher Is Nothing Then
Launcher = ExeFile
Log($"[Modpack] 发现整合包附带的疑似第三方启动器:{ExeFile}")
End If
End If
Next
Task.Progress = 0.95
'尝试使用附带的启动器打开
If Launcher IsNot Nothing Then
Log("[Modpack] 找到压缩包中附带的启动器:" & Launcher)
If MyMsgBox($"整合包里似乎自带了启动器,是否换用它继续安装?{vbCrLf}即将打开:{Launcher}", "换用整合包启动器?", "换用", "不换用") = 1 Then
OpenExplorer(TargetFolder)
Try
ShellOnly(Launcher, "--wait") '要求等待已有的 PCL 退出
Log("[Modpack] 为换用整合包中的启动器启动,强制结束程序")
FrmMain.EndProgram(False)
Catch ex As Exception
Log(ex, "打开文件失败", LogLevel.Msgbox)
End Try
Return
End If
Else
Log("[Modpack] 未找到压缩包中附带的启动器")
End If
OpenExplorer(TargetFolder)
'加入文件夹列表
Dim VersionName As String = GetFolderNameFromPath(TargetFolder)
Directory.CreateDirectory(TargetFolder & ".minecraft\")
PageSelectLeft.AddFolder(
TargetFolder & ".minecraft\" & ArchiveBaseFolder.Replace("/", "\").TrimStart("\"), '格式例如:包裹文件夹\.minecraft\(最短为空字符串)
VersionName, False)
'调用 modpack 文件进行安装
Dim ModpackFile = Directory.GetFiles(TargetFolder, "modpack.*", SearchOption.AllDirectories).First
Log("[Modpack] 调用 modpack 文件继续安装:" & ModpackFile)
ModpackInstall(ModpackFile)
End Sub)
})
Loader.Start(TargetFolder)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
Return Loader Return Loader
End Function End Function
'普通压缩包 '普通压缩包
Private Function InstallPackCompress(FileAddress As String, ArchiveBaseFolder As String) As LoaderCombo(Of String) Private Function InstallPackCompress(FileAddress As String, Archive As Compression.ZipArchive) As LoaderCombo(Of String)
MyMsgBox("请在接下来打开的窗口中选择安装目标文件夹,它必须是一个空文件夹。", "安装提示", "继续", ForceWait:=True) '尝试定位 .minecraft 文件夹:寻找形如 “/versions/XXX/XXX.json” 的路径
Dim Match As RegularExpressions.Match = Nothing
Dim Regex As New RegularExpressions.Regex("^.*\/(?=versions\/(?<ver>[^\/]+)\/(\k<ver>)\.json$)", RegularExpressions.RegexOptions.IgnoreCase)
For Each Entry In Archive.Entries
Dim EntryMatch = Regex.Match("/" & Entry.FullName)
If EntryMatch.Success Then
Match = EntryMatch
Exit For
End If
Next
If Match Is Nothing Then Throw New Exception("未能找到适合的文件结构,这可能不是一个 MC 压缩包") '没有匹配
Dim ArchiveBaseFolder As String = Match.Value.Replace("/", "\").TrimStart("\") '格式例如:包裹文件夹\.minecraft\(最短为空字符串)
Dim VersionName As String = Match.Groups(1).Value
Log("[ModPack] 检测到压缩包的 .minecraft 根目录:" & ArchiveBaseFolder & ",命中的版本名:" & VersionName)
'获取解压路径 '获取解压路径
MyMsgBox("接下来请选择一个空文件夹,它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
Dim TargetFolder As String = SelectFolder("选择安装目标(必须是一个空文件夹)") Dim TargetFolder As String = SelectFolder("选择安装目标(必须是一个空文件夹)")
If String.IsNullOrEmpty(TargetFolder) Then Return Nothing If String.IsNullOrEmpty(TargetFolder) Then Throw New CancelledException
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号!", HintType.Critical) : Return Nothing If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号!", HintType.Critical) : Throw New CancelledException
If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标!", HintType.Critical) : Return Nothing If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标!", HintType.Critical) : Throw New CancelledException
'要求显示名称
Dim NewName As String = MyMsgBoxInput("输入显示名称", "输入该文件夹在左边栏列表中显示的名称。", GetFolderNameFromPath(TargetFolder),
New ObjectModel.Collection(Of Validate) From {New ValidateNullOrWhiteSpace, New ValidateLength(1, 30), New ValidateExcept({">", "|"})})
If String.IsNullOrWhiteSpace(NewName) Then Return Nothing
'解压 '解压
Dim Loader As New LoaderCombo(Of String)("安装压缩包", { Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
New LoaderTask(Of String, Integer)("安装压缩包", New LoaderTask(Of String, Integer)("解压压缩包",
Sub() Sub(Task As LoaderTask(Of String, Integer))
UnpackFiles(TargetFolder, FileAddress, Nothing) ExtractModpackFiles(TargetFolder, FileAddress, Task, 0.95)
PageSelectLeft.AddFolder(TargetFolder, NewName, False) '加入文件夹列表 '加入文件夹列表
End Sub) PageSelectLeft.AddFolder(TargetFolder & ArchiveBaseFolder, GetFolderNameFromPath(TargetFolder), False)
}) Thread.Sleep(400) '避免文件争用
Loader.Start() RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.VersionSelect))
End Sub)
}) With {.OnStateChanged = AddressOf McInstallState}
Loader.Start(TargetFolder)
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble() FrmMain.BtnExtraDownload.Ribble()
@@ -88,26 +88,27 @@
AddHandler GameProcess.ErrorDataReceived, AddressOf LogReceived AddHandler GameProcess.ErrorDataReceived, AddressOf LogReceived
'初始化时钟 '初始化时钟
RunInNewThread(Sub() RunInNewThread(
Try Sub()
Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Crashed OrElse State = MinecraftState.Canceled OrElse Loader.State = LoadState.Aborted Try
TimerWindow() Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Crashed OrElse State = MinecraftState.Canceled OrElse Loader.State = LoadState.Aborted
TimerLog() TimerWindow()
'设置窗口标题 TimerLog()
For i = 1 To 3 '设置窗口标题
If IsWindowFinished AndAlso IsWindowAppeared AndAlso WindowTitle <> "" AndAlso State = MinecraftState.Running AndAlso Not GameProcess.HasExited Then For i = 1 To 3
Dim RealTitle As String = WindowTitle.Replace("{date}", Date.Now.ToString("yyyy/M/d")).Replace("{time}", Date.Now.ToString("HH:mm:ss")) If IsWindowFinished AndAlso IsWindowAppeared AndAlso WindowTitle <> "" AndAlso State = MinecraftState.Running AndAlso Not GameProcess.HasExited Then
SetWindowText(WindowHandle, RealTitle.ToCharArray) Dim RealTitle As String = WindowTitle.Replace("{date}", Date.Now.ToString("yyyy/M/d")).Replace("{time}", Date.Now.ToString("HH:mm:ss"))
End If SetWindowText(WindowHandle, RealTitle.ToCharArray)
Thread.Sleep(64) End If
Next Thread.Sleep(64)
Loop Next
WatcherLog("Minecraft 日志监控已退出") Loop
Catch ex As Exception WatcherLog("Minecraft 日志监控已退出")
Log(ex, "Minecraft 日志监控主循环出错", LogLevel.Feedback) Catch ex As Exception
State = MinecraftState.Ended Log(ex, "Minecraft 日志监控主循环出错", LogLevel.Feedback)
End Try State = MinecraftState.Ended
End Sub, "Minecraft Watcher PID " & PID) End Try
End Sub, "Minecraft Watcher PID " & PID)
End Sub End Sub
'状态 '状态
@@ -349,22 +350,21 @@
WatcherLog("Minecraft 已崩溃,将在 2 秒后开始崩溃分析") WatcherLog("Minecraft 已崩溃,将在 2 秒后开始崩溃分析")
Hint("检测到 Minecraft 出现错误,错误分析已开始……") Hint("检测到 Minecraft 出现错误,错误分析已开始……")
FeedbackInfo() FeedbackInfo()
RunInNewThread(Sub() RunInNewThread(
Try Sub()
Thread.Sleep(2000) Try
WatcherLog("崩溃分析开始") Thread.Sleep(2000)
Dim Analyzer As New CrashAnalyzer(PID) WatcherLog("崩溃分析开始")
Analyzer.Collect(Version.PathIndie, LatestLog.ToList) Dim Analyzer As New CrashAnalyzer(PID)
Analyzer.Prepare() Analyzer.Collect(Version.PathIndie, LatestLog.ToList)
Analyzer.Analyze(Version) Analyzer.Prepare()
Analyzer.Output(False, New List(Of String) From Analyzer.Analyze(Version)
{Version.Path & Version.Name & ".json", Analyzer.Output(False, New List(Of String) From
Path & "PCL\Log1.txt", {Version.Path & Version.Name & ".json", Path & "PCL\Log1.txt", Path & "PCL\LatestLaunch.bat"})
Path & "PCL\LatestLaunch.bat"}) Catch ex As Exception
Catch ex As Exception Log(ex, "崩溃分析失败", LogLevel.Feedback)
Log(ex, "崩溃分析失败", LogLevel.Feedback) End Try
End Try End Sub, "Crash Analyzer")
End Sub, "Crash Analyzer")
End Sub End Sub
'强制关闭 '强制关闭
@@ -1,6 +1,7 @@
<Grid x:Class="MyCompItem" <Grid x:Class="MyCompItem"
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"
x:Name="PanBack" Height="64" x:Name="PanBack" Height="64"
RenderTransformOrigin="0.5,0.5" Background="{StaticResource ColorBrushSemiTransparent}" SnapsToDevicePixels="True"> RenderTransformOrigin="0.5,0.5" Background="{StaticResource ColorBrushSemiTransparent}" SnapsToDevicePixels="True">
<Grid.ColumnDefinitions> <Grid.ColumnDefinitions>
@@ -23,7 +24,7 @@
<Border.Clip> <Border.Clip>
<RectangleGeometry Rect="0,0,50,50" RadiusX="6" RadiusY="6" /> <RectangleGeometry Rect="0,0,50,50" RadiusX="6" RadiusY="6" />
</Border.Clip> </Border.Clip>
<Image x:Name="PathLogo" RenderOptions.BitmapScalingMode="HighQuality" /> <local:MyImage x:Name="PathLogo" RenderOptions.BitmapScalingMode="HighQuality" FallbackSource="pack://application:,,,/images/Icons/NoIcon.png" />
</Border> </Border>
<!-- 标题 --> <!-- 标题 -->
<StackPanel Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0" Orientation="Horizontal" <StackPanel Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0" Orientation="Horizontal"
@@ -4,93 +4,14 @@
Public Uuid As Integer = GetUuid() Public Uuid As Integer = GetUuid()
'Logo 'Logo
Private _Logo As String = ""
Public Property Logo As String Public Property Logo As String
Get Get
Return _Logo Return PathLogo.Source
End Get End Get
Set(value As String) Set(value As String)
If _Logo = value OrElse value Is Nothing Then Exit Property PathLogo.Source = value
_Logo = value
Dim FileAddress = PathTemp & "CompLogo\" & GetHash(_Logo) & ".png"
Try
If _Logo.StartsWithF("http", True) Then
'网络图片
If File.Exists(FileAddress) Then
PathLogo.Source = New MyBitmap(FileAddress)
Else
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
RunInNewThread(Sub() LogoLoader(FileAddress), "Comp Logo Loader " & Uuid & "#", ThreadPriority.BelowNormal)
End If
Else
'位图
PathLogo.Source = New MyBitmap(_Logo)
End If
Catch ex As IOException
Log(ex, "加载资源工程图标时读取失败(" & FileAddress & ")")
Catch ex As ArgumentException
'考虑缓存的图片本身可能有误
Log(ex, "可视化资源工程图标失败(" & FileAddress & ")")
Try
File.Delete(FileAddress)
Log("[Comp] 已清理损坏的资源工程图标:" & FileAddress)
Catch exx As Exception
Log(exx, "清理损坏的资源工程图标缓存失败(" & FileAddress & ")", LogLevel.Hint)
End Try
Catch ex As Exception
Log(ex, "加载资源工程图标失败(" & value & ")")
End Try
End Set End Set
End Property End Property
'后台加载 Logo
Private Sub LogoLoader(LocalFileAddress As String)
Dim Retried As Boolean = False
Dim DownloadEnd As String = GetUuid()
RetryStart:
Try
'CurseForge 图片使用缩略图
Dim Url As String = _Logo
If Url.Contains("/256/256/") AndAlso GetPixelSize(1) <= 1.25 AndAlso Not Retried Then
Url = Url.Replace("/256/256/", "/64/64/") '#3075:部分 Mod 不存在 64x64 图标,所以重试时不再缩小
End If
'下载图片
NetDownload(Url, LocalFileAddress & DownloadEnd, True)
If Url.EndsWithF("webp") Then
Log($"[Comp] Webp 格式转换:{LocalFileAddress}")
Dim dec = New Imazen.WebP.SimpleDecoder()
Dim picFile = File.ReadAllBytes(LocalFileAddress & DownloadEnd)
dec.DecodeFromBytes(picFile, picFile.Length).Save(LocalFileAddress & DownloadEnd)
End If
Dim LoadError As Exception = Nothing
RunInUiWait(
Sub()
Try
'在地址更换时取消加载
If LocalFileAddress <> $"{PathTemp}CompLogo\{GetHash(_Logo)}.png" Then Exit Sub
'在完成正常加载后才保存缓存图片
PathLogo.Source = New MyBitmap(LocalFileAddress & DownloadEnd)
Catch ex As Exception
Log(ex, $"读取资源工程图标失败({LocalFileAddress})")
File.Delete(LocalFileAddress & DownloadEnd)
LoadError = ex
End Try
End Sub)
If LoadError IsNot Nothing Then Throw LoadError
If File.Exists(LocalFileAddress) Then
File.Delete(LocalFileAddress & DownloadEnd)
Else
FileIO.FileSystem.MoveFile(LocalFileAddress & DownloadEnd, LocalFileAddress)
End If
Catch ex As Exception
If Not Retried Then
Retried = True
GoTo RetryStart
Else
Log(ex, $"下载资源工程图标失败({_Logo})")
RunInUi(Sub() PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png"))
End If
End Try
End Sub
'标题 '标题
Public Property Title As String Public Property Title As String
@@ -175,7 +96,7 @@ RetryStart:
'记录当前展开的卡片标题(#2712) '记录当前展开的卡片标题(#2712)
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.PanMain.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.IsSwaped Then Titles.Add(Card.Title)
Next Next
Log("[Comp] 记录当前已展开的卡片:" & String.Join("、", Titles)) Log("[Comp] 记录当前已展开的卡片:" & String.Join("、", Titles))
@@ -253,7 +174,7 @@ RetryStart:
''' <summary> ''' <summary>
''' 是否允许交互。目前仅用于 PageDownloadCompDetail 的顶部栏展示:若关闭碰撞检测,则无法展开 Tooltip。 ''' 是否允许交互。目前仅用于 PageDownloadCompDetail 的顶部栏展示:若关闭碰撞检测,则无法展开 Tooltip。
''' </summary> ''' </summary>
Public CanInteraction As Boolean = True Public Property CanInteraction As Boolean = True
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 Not CanInteraction Then Exit Sub If Not CanInteraction Then Exit Sub
'判断当前颜色 '判断当前颜色
@@ -24,30 +24,27 @@
<Border.Clip> <Border.Clip>
<RectangleGeometry Rect="0,0,34,34" RadiusX="6" RadiusY="6" /> <RectangleGeometry Rect="0,0,34,34" RadiusX="6" RadiusY="6" />
</Border.Clip> </Border.Clip>
<Image x:Name="PathLogo" RenderOptions.BitmapScalingMode="HighQuality" /> <local:MyImage x:Name="PathLogo" RenderOptions.BitmapScalingMode="HighQuality" FallbackSource="pack://application:,,,/images/Icons/NoIcon.png" />
</Border> </Border>
<!-- 标题 --> <!-- 标题 -->
<StackPanel Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0" Orientation="Horizontal" <Grid Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0"
SnapsToDevicePixels="False" UseLayoutRounding="False"> SnapsToDevicePixels="False" UseLayoutRounding="False" x:Name="PanTitle">
<TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" IsHitTestVisible="False" /> <Grid.ColumnDefinitions>
<TextBlock x:Name="LabTitleRaw" TextTrimming="WordEllipsis" FontSize="12" IsHitTestVisible="False" <ColumnDefinition Width="Auto" x:Name="ColumnTitle" />
<ColumnDefinition Width="Auto" x:Name="ColumnSubtitle" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" x:Name="ColumnExtend" />
</Grid.ColumnDefinitions>
<TextBlock x:Name="LabTitle" TextTrimming="CharacterEllipsis" FontSize="14" IsHitTestVisible="False" />
<TextBlock x:Name="LabSubtitle" Grid.Column="1" HorizontalAlignment="Left"
TextTrimming="CharacterEllipsis" FontSize="12" IsHitTestVisible="False"
Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" /> Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" />
<!-- 更新按钮 --> <!-- 更新按钮 -->
<local:MyIconButton Width="21" Height="21" Margin="-2,-1.6,0,0" x:Name="BtnUpdate" Theme="Black" Opacity="0.4" Visibility="Collapsed" <local:MyIconButton Grid.Column="2"
Width="21" Height="21" Margin="-2,-1.6,0,0" x:Name="BtnUpdate" Theme="Black" Opacity="0.4" Visibility="Collapsed"
ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="100" ToolTipService.VerticalOffset="-9" ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="100" ToolTipService.VerticalOffset="-9"
Logo="M640 768H384l-32-32V509H213L190 454l298-298h45l298 298L810 509h-138v226z m-224-64h192V477l32-32h93L512 223 290 445H384l32 32zM352 831h320v64h-320z" /> Logo="M640 768H384l-32-32V509H213L190 454l298-298h45l298 298L810 509h-138v226z m-224-64h192V477l32-32h93L512 223 290 445H384l32 32zM352 831h320v64h-320z" />
</StackPanel> </Grid>
<!--<Grid Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0" IsHitTestVisible="False" SnapsToDevicePixels="False" UseLayoutRounding="False">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="Auto" />
</Grid.ColumnDefinitions>
<TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" Grid.Column="0" />
<TextBlock x:Name="LabTitleRaw" TextTrimming="WordEllipsis" FontSize="12" Grid.Column="1"
Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" />
<local:MyIconTextButton Grid.Column="2" Text="更新" />
</Grid>-->
<!-- Tag 与 详情 --> <!-- Tag 与 详情 -->
<StackPanel x:Name="PanTags" Grid.Row="2" Grid.Column="3" Orientation="Horizontal" VerticalAlignment="Bottom" Margin="-1,0,1,0" Visibility="Collapsed" IsHitTestVisible="False"> <StackPanel x:Name="PanTags" Grid.Row="2" Grid.Column="3" Orientation="Horizontal" VerticalAlignment="Bottom" Margin="-1,0,1,0" Visibility="Collapsed" IsHitTestVisible="False">
<!--<Border Background="{DynamicResource ColorBrush6}" Padding="3,1" CornerRadius="3" Margin="0,0,4,0" SnapsToDevicePixels="True" UseLayoutRounding="False"> <!--<Border Background="{DynamicResource ColorBrush6}" Padding="3,1" CornerRadius="3" Margin="0,0,4,0" SnapsToDevicePixels="True" UseLayoutRounding="False">
@@ -55,6 +52,6 @@
</Border>--> </Border>-->
</StackPanel> </StackPanel>
<TextBlock x:Name="LabInfo" Grid.Row="2" Grid.Column="4" VerticalAlignment="Bottom" Margin="0,0,3,1" <TextBlock x:Name="LabInfo" Grid.Row="2" Grid.Column="4" VerticalAlignment="Bottom" Margin="0,0,3,1"
TextTrimming="CharacterEllipsis" FontSize="12" Foreground="{StaticResource ColorBrushGray3}" TextTrimming="CharacterEllipsis" FontSize="12" Foreground="{StaticResource ColorBrushGray4}"
IsHitTestVisible="False" SnapsToDevicePixels="False" UseLayoutRounding="False" /> IsHitTestVisible="False" SnapsToDevicePixels="False" UseLayoutRounding="False" />
</Grid> </Grid>
@@ -6,93 +6,14 @@ Public Class MyLocalModItem
Public Uuid As Integer = GetUuid() Public Uuid As Integer = GetUuid()
'Logo 'Logo
Private _Logo As String = ""
Public Property Logo As String Public Property Logo As String
Get Get
Return _Logo Return PathLogo.Source
End Get End Get
Set(value As String) Set(value As String)
If _Logo = value OrElse value Is Nothing Then Exit Property PathLogo.Source = value
_Logo = value
Dim FileAddress = PathTemp & "CompLogo\" & GetHash(_Logo) & ".png"
Try
If _Logo.StartsWithF("http", True) Then
'网络图片
If File.Exists(FileAddress) Then
PathLogo.Source = New MyBitmap(FileAddress)
Else
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
RunInNewThread(Sub() LogoLoader(FileAddress), "Comp Logo Loader " & Uuid & "#", ThreadPriority.BelowNormal)
End If
Else
'位图
PathLogo.Source = New MyBitmap(_Logo)
End If
Catch ex As IOException
Log(ex, "加载本地 Mod 图标时读取失败(" & FileAddress & ")")
Catch ex As ArgumentException
'考虑缓存的图片本身可能有误
Log(ex, "可视化本地 Mod 图标失败(" & FileAddress & ")")
Try
File.Delete(FileAddress)
Log("[LocalModItem] 已清理损坏的本地 Mod 图标:" & FileAddress)
Catch exx As Exception
Log(exx, "清理损坏的本地 Mod 图标缓存失败(" & FileAddress & ")", LogLevel.Hint)
End Try
Catch ex As Exception
Log(ex, "加载本地 Mod 图标失败(" & value & ")")
End Try
End Set End Set
End Property End Property
'后台加载 Logo
Private Sub LogoLoader(LocalFileAddress As String)
Dim Retried As Boolean = False
Dim DownloadEnd As String = GetUuid()
RetryStart:
Try
'CurseForge 图片使用缩略图
Dim Url As String = _Logo
If Url.Contains("/256/256/") AndAlso GetPixelSize(1) <= 1.25 AndAlso Not Retried Then
Url = Url.Replace("/256/256/", "/64/64/") '#3075:部分 Mod 不存在 64x64 图标,所以重试时不再缩小
End If
'下载图片
NetDownload(Url, LocalFileAddress & DownloadEnd, True)
If Url.EndsWithF("webp") Then
Log($"[Comp] Webp 格式转换:{LocalFileAddress}")
Dim dec = New Imazen.WebP.SimpleDecoder()
Dim picFile = File.ReadAllBytes(LocalFileAddress & DownloadEnd)
dec.DecodeFromBytes(picFile, picFile.Length).Save(LocalFileAddress & DownloadEnd)
End If
Dim LoadError As Exception = Nothing
RunInUiWait(
Sub()
Try
'在地址更换时取消加载
If LocalFileAddress <> $"{PathTemp}CompLogo\{GetHash(_Logo)}.png" Then Exit Sub
'在完成正常加载后才保存缓存图片
PathLogo.Source = New MyBitmap(LocalFileAddress & DownloadEnd)
Catch ex As Exception
Log(ex, "读取本地 Mod 图标失败(" & LocalFileAddress & ")")
File.Delete(LocalFileAddress & DownloadEnd)
LoadError = ex
End Try
End Sub)
If LoadError IsNot Nothing Then Throw LoadError
If File.Exists(LocalFileAddress) Then
File.Delete(LocalFileAddress & DownloadEnd)
Else
FileIO.FileSystem.MoveFile(LocalFileAddress & DownloadEnd, LocalFileAddress)
End If
Catch ex As Exception
If Not Retried Then
Retried = True
GoTo RetryStart
Else
Log(ex, $"下载本地 Mod 图标失败({_Logo})")
RunInUi(Sub() PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png"))
End If
End Try
End Sub
'标题 '标题
Private _Title As String Private _Title As String
@@ -107,7 +28,7 @@ RetryStart:
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.Unavaliable Case McMod.McModState.Unavailable
LabTitle.TextDecorations = TextDecorations.Strikethrough LabTitle.TextDecorations = TextDecorations.Strikethrough
value &= " [错误]" value &= " [错误]"
End Select End Select
@@ -120,12 +41,12 @@ RetryStart:
'副标题 '副标题
Public Property SubTitle As String Public Property SubTitle As String
Get Get
Return If(LabTitleRaw?.Text, "") Return If(LabSubtitle?.Text, "")
End Get End Get
Set(value As String) Set(value As String)
If LabTitleRaw.Text = value Then Exit Property If LabSubtitle.Text = value Then Exit Property
LabTitleRaw.Text = value LabSubtitle.Text = value
LabTitleRaw.Visibility = If(value = "", Visibility.Collapsed, Visibility.Visible) LabSubtitle.Visibility = If(value = "", Visibility.Collapsed, Visibility.Visible)
End Set End Set
End Property End Property
@@ -148,9 +69,9 @@ RetryStart:
For Each TagText In value For Each TagText In value
Dim NewTag = GetObjectFromXML( Dim NewTag = GetObjectFromXML(
"<Border xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" "<Border xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation""
Background=""#11000000"" Padding=""3,1"" CornerRadius=""3"" Margin=""0,0,3,0"" Background=""#0C000000"" Padding=""3,1"" CornerRadius=""3"" Margin=""0,0,3,0""
SnapsToDevicePixels=""True"" UseLayoutRounding=""False""> SnapsToDevicePixels=""True"" UseLayoutRounding=""False"">
<TextBlock Text=""" & TagText & """ Foreground=""#868686"" FontSize=""11"" /> <TextBlock Text=""" & TagText & """ Foreground=""#88000000"" FontSize=""11"" />
</Border>") </Border>")
PanTags.Children.Add(NewTag) PanTags.Children.Add(NewTag)
Next Next
@@ -216,13 +137,14 @@ RetryStart:
Exit Sub Exit Sub
End If End If
'计算滑动范围 '计算滑动范围
Dim Index = CType(Parent, StackPanel).Children.IndexOf(Me) Dim Elements = CType(Parent, StackPanel).Children
SwipeStart = Math.Min(SwipeStart, Index) Dim Index As Integer = Elements.IndexOf(Me)
SwipeEnd = Math.Max(SwipeEnd, Index) SwipeStart = MathClamp(Math.Min(SwipeStart, Index), 0, Elements.Count - 1)
SwipeEnd = MathClamp(Math.Max(SwipeEnd, Index), 0, Elements.Count - 1)
'勾选所有范围中的项 '勾选所有范围中的项
If SwipeStart = SwipeEnd Then Exit Sub If SwipeStart = SwipeEnd Then Exit Sub
For i = SwipeStart To SwipeEnd For i = SwipeStart To SwipeEnd
Dim Item As MyLocalModItem = CType(Parent, StackPanel).Children(i) Dim Item As MyLocalModItem = Elements(i)
Item.InitLate(Item, e) Item.InitLate(Item, e)
Item.Checked = SwipToState Item.Checked = SwipToState
Next Next
@@ -382,57 +304,75 @@ RetryStart:
#End Region #End Region
Public Sub Refresh() Private Function GetUpdateCompareDescription() As String
Dim CurrentName = Entry.CompFile.FileName.Replace(".jar", "")
Dim NewestName = Entry.UpdateFile.FileName.Replace(".jar", "")
'简化名称对比
Dim CurrentSegs = CurrentName.Split("-"c).ToList()
Dim NewestSegs = NewestName.Split("-"c).ToList()
Dim Shortened As Boolean = False
For Each Seg In CurrentSegs.ToList()
If Not NewestSegs.Contains(Seg) Then Continue For
CurrentSegs.Remove(Seg)
NewestSegs.Remove(Seg)
Shortened = True
Next
If Shortened AndAlso CurrentSegs.Any() AndAlso NewestSegs.Any() Then
CurrentName = Join(CurrentSegs, "-")
NewestName = Join(NewestSegs, "-")
Entry._Version = CurrentName '使用网络信息作为显示的版本号
End If
Return $"当前版本:{CurrentName}({GetTimeSpanString(Entry.CompFile.ReleaseDate - Date.Now, False)}){vbCrLf}最新版本:{NewestName}({GetTimeSpanString(Entry.UpdateFile.ReleaseDate - Date.Now, False)})"
End Function
Public Sub Refresh() Handles Me.Loaded
RunInUi( RunInUi(
Sub() Sub()
'更新 '更新
If Entry.CanUpdate Then If Entry.CanUpdate Then
BtnUpdate.Visibility = Visibility.Visible BtnUpdate.Visibility = Visibility.Visible
Dim CurrentName = Entry.CompFile.FileName.Replace(".jar", "") BtnUpdate.ToolTip = $"{GetUpdateCompareDescription()}{vbCrLf}点击以更新,右键查看更新日志。"
Dim NewestName = Entry.UpdateFile.FileName.Replace(".jar", "")
'简化名称对比
Dim CurrentSegs = CurrentName.Split("-"c).ToList()
Dim NewestSegs = NewestName.Split("-"c).ToList()
Dim Shortened As Boolean = False
For Each Seg In CurrentSegs.ToList()
If Not NewestSegs.Contains(Seg) Then Continue For
CurrentSegs.Remove(Seg)
NewestSegs.Remove(Seg)
Shortened = True
Next
If Shortened AndAlso CurrentSegs.Any() AndAlso NewestSegs.Any() Then
CurrentName = Join(CurrentSegs, "-")
NewestName = Join(NewestSegs, "-")
Entry._Version = CurrentName '使用网络信息作为显示的版本号
End If
BtnUpdate.ToolTip = $"当前版本:{CurrentName} ({Entry.CompFile.ReleaseDate:yyyy/MM/dd HH:mm:ss}){vbCrLf}最新版本:{NewestName} ({Entry.UpdateFile.ReleaseDate:yyyy/MM/dd HH:mm:ss}){vbCrLf}点击以更新,右键查看更新日志。"
Else Else
BtnUpdate.Visibility = Visibility.Collapsed BtnUpdate.Visibility = Visibility.Collapsed
End If End If
'标题 '标题与描述
If Entry.Comp Is Nothing Then Dim DescFileName As String
Title = Entry.Name
SubTitle = If(Entry.Version Is Nothing, "", " | " & Entry.Version)
Else
Dim Titles = Entry.Comp.GetControlTitle(False)
Title = Titles.Key
SubTitle = Titles.Value & If(Entry.Version Is Nothing, "", " | " & Entry.Version)
End If
If Checked Then
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush2", "ColorBrush5"))
Else
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush1", "ColorBrushGray4"))
End If
'描述
Dim NewDescription As String
Select Case Entry.State Select Case Entry.State
Case McMod.McModState.Fine Case McMod.McModState.Fine
NewDescription = GetFileNameWithoutExtentionFromPath(Entry.Path) DescFileName = GetFileNameWithoutExtentionFromPath(Entry.Path)
Case McMod.McModState.Disabled Case McMod.McModState.Disabled
NewDescription = GetFileNameWithoutExtentionFromPath(Entry.Path.Replace(".disabled", "").Replace(".old", "")) DescFileName = GetFileNameWithoutExtentionFromPath(Entry.Path.Replace(".disabled", "").Replace(".old", ""))
Case Else 'McMod.McModState.Unavaliable Case Else 'McMod.McModState.Unavailable
NewDescription = GetFileNameFromPath(Entry.Path) DescFileName = GetFileNameFromPath(Entry.Path)
End Select End Select
Dim NewDescription As String
If Setup.Get("ToolModLocalNameStyle") = 1 Then
'标题显示文件名,详情显示译名
'标题
Title = DescFileName
SubTitle = ""
'描述
If Entry.Comp Is Nothing Then
NewDescription = Entry.Name
Else
Dim Titles = Entry.Comp.GetControlTitle(False)
NewDescription = Titles.Key & Titles.Value
End If
NewDescription = NewDescription.Replace(" | ", " / ")
If Entry.Version IsNot Nothing Then NewDescription &= $" ({Entry.Version})"
Else
'标题显示译名,详情显示文件名
'标题
If Entry.Comp Is Nothing Then
Title = Entry.Name
SubTitle = If(Entry.Version Is Nothing, "", " | " & Entry.Version)
Else
Dim Titles = Entry.Comp.GetControlTitle(False)
Title = Titles.Key
SubTitle = Titles.Value & If(Entry.Version Is Nothing, "", " | " & Entry.Version)
End If
'描述
NewDescription = DescFileName
End If
If Entry.Comp IsNot Nothing Then If Entry.Comp IsNot Nothing Then
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
@@ -441,6 +381,11 @@ RetryStart:
NewDescription += ": " & "存在错误,无法获取信息" NewDescription += ": " & "存在错误,无法获取信息"
End If End If
Description = NewDescription Description = NewDescription
If Checked Then
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush2", "ColorBrush5"))
Else
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush1", "ColorBrushGray4"))
End If
'主 Logo '主 Logo
Logo = If(Entry.Comp Is Nothing, PathImage & "Icons/NoIcon.png", Entry.Comp.GetControlLogo()) Logo = If(Entry.Comp Is Nothing, PathImage & "Icons/NoIcon.png", Entry.Comp.GetControlLogo())
'图标右下角的 Logo '图标右下角的 Logo
@@ -461,7 +406,7 @@ RetryStart:
'<Image x:Name="ImgState" RenderOptions.BitmapScalingMode="HighQuality" Width="16" Height="16" Margin="0,0,-3,-1" '<Image x:Name="ImgState" RenderOptions.BitmapScalingMode="HighQuality" Width="16" Height="16" Margin="0,0,-3,-1"
' Grid.Column="1" Grid.Row="1" Grid.RowSpan="2" IsHitTestVisible="False" ' Grid.Column="1" Grid.Row="1" Grid.RowSpan="2" IsHitTestVisible="False"
' HorizontalAlignment="Right" VerticalAlignment="Bottom" ' HorizontalAlignment="Right" VerticalAlignment="Bottom"
' Source="/Images/Icons/Unavaliable.png" /> ' Source="/Images/Icons/Unavailable.png" />
End If End If
ImgState.Source = New MyBitmap(PathImage & $"Icons/{Entry.State}.png") ImgState.Source = New MyBitmap(PathImage & $"Icons/{Entry.State}.png")
End If End If
@@ -517,8 +462,11 @@ RetryStart:
End Sub End Sub
'显示更新日志 '显示更新日志
Private Sub ShowUpdateLog(sender As Object, e As MouseButtonEventArgs) Handles BtnUpdate.PreviewMouseRightButtonUp Private Sub BtnUpdate_PreviewMouseRightButtonUp(sender As Object, e As MouseButtonEventArgs) Handles BtnUpdate.PreviewMouseRightButtonUp
e.Handled = True e.Handled = True
ShowUpdateLog()
End Sub
Private Sub ShowUpdateLog()
Dim CurseForgeUrl As String = Entry.ChangelogUrls.FirstOrDefault(Function(x) x.Contains("curseforge.com")) Dim CurseForgeUrl As String = Entry.ChangelogUrls.FirstOrDefault(Function(x) x.Contains("curseforge.com"))
Dim ModrinthUrl As String = Entry.ChangelogUrls.FirstOrDefault(Function(x) x.Contains("modrinth.com")) Dim ModrinthUrl As String = Entry.ChangelogUrls.FirstOrDefault(Function(x) x.Contains("modrinth.com"))
If CurseForgeUrl Is Nothing OrElse ModrinthUrl Is Nothing Then If CurseForgeUrl Is Nothing OrElse ModrinthUrl Is Nothing Then
@@ -535,7 +483,62 @@ RetryStart:
'触发更新 '触发更新
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
FrmVersionMod.UpdateMods({Entry}) Select Case MyMsgBox($"是否要更新 {Entry.Name}?{vbCrLf}{vbCrLf}{GetUpdateCompareDescription()}", "Mod 更新确认", "更新", "查看更新日志", "取消")
Case 1 '更新
FrmVersionMod.UpdateMods({Entry})
Case 2 '查看更新日志
ShowUpdateLog()
Case 3 '取消
End Select
End Sub
'自适应(#4465)
Private Sub PanTitle_SizeChanged() Handles PanTitle.SizeChanged
'0:全部舒展:Auto - Auto - (Auto) - 1*
'1:压缩 Subtitle:Auto - 1* - (Auto) - 0
'2:继续压缩 Title:1* - 0 - (Auto) - 0
Dim CurrentCompressLevel As Integer =
If(ColumnExtend.Width.IsStar, 0, If(ColumnTitle.Width.IsStar, 2, 1)) 'Subtitle 可能是 Collapsed
Dim NewCompressLevel As Integer
Select Case CurrentCompressLevel
Case 0
If ColumnExtend.ActualWidth < 0.5 Then
NewCompressLevel = If(LabSubtitle.Visibility = Visibility.Collapsed, 2, 1)
Else
Return
End If
Case 1
If ColumnSubtitle.ActualWidth < 0.5 Then
NewCompressLevel = 2
ElseIf Not LabSubtitle.IsTextTrimmed Then
NewCompressLevel = 0
Else
Return
End If
Case 2
If Not LabTitle.IsTextTrimmed Then
NewCompressLevel = If(LabSubtitle.Visibility = Visibility.Collapsed, 0, 1)
Else
Return
End If
End Select
Select Case NewCompressLevel
Case 0
'全部舒展:Auto - Auto - (Auto) - 1*
ColumnTitle.Width = GridLength.Auto
ColumnSubtitle.Width = GridLength.Auto
ColumnExtend.Width = New GridLength(1, GridUnitType.Star)
Case 1
'压缩 Subtitle:Auto - 1* - (Auto) - 0
ColumnTitle.Width = GridLength.Auto
ColumnSubtitle.Width = New GridLength(1, GridUnitType.Star)
ColumnExtend.Width = New GridLength(0, GridUnitType.Pixel)
Case 2
'继续压缩 Title:1* - 0 - (Auto) - 0
ColumnTitle.Width = New GridLength(1, GridUnitType.Star)
ColumnSubtitle.Width = New GridLength(0, GridUnitType.Pixel)
ColumnExtend.Width = New GridLength(0, GridUnitType.Pixel)
End Select
End Sub End Sub
End Class End Class
@@ -1,3 +1,8 @@
Public Module ModDevelop Public Module ModDevelop
#If DEBUG Then
Public Sub Start()
End Sub
#End If
End Module End Module
+33 -14
View File
@@ -20,7 +20,7 @@
Hint("正在开启中,请稍候……") Hint("正在开启中,请稍候……")
OpenWebsite(Data(0)) OpenWebsite(Data(0))
Case "打开文件", "打开帮助" Case "打开文件", "打开帮助", "执行命令"
RunInThread( RunInThread(
Sub() Sub()
Try Try
@@ -29,15 +29,25 @@
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 = "打开帮助" Then
PageOtherHelp.EnterHelpPage(Location)
Else
If Not Setup.Get("HintCustomCommand") Then
Select Case MyMsgBox(
"即将执行:" & Location & If(Data.Length >= 2, " " & Data(1), "") & vbCrLf &
"请在确认该操作没有安全隐患后继续。", "执行确认", "继续", "继续且今后不再要求确认", "取消")
Case 2
Setup.Set("HintCustomCommand", True)
Case 3
Exit Sub
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(Data.Length >= 2, Data(1), ""),
.FileName = Location, .FileName = Location,
.WorkingDirectory = WorkingDir .WorkingDirectory = ShortenPath(WorkingDir)
} }
Process.Start(Info) Process.Start(Info)
Else '打开帮助
PageOtherHelp.EnterHelpPage(Location)
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "执行打开类自定义事件失败", LogLevel.Msgbox) Log(ex, "执行打开类自定义事件失败", LogLevel.Msgbox)
@@ -92,7 +102,18 @@
MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL 不支持其他乱七八糟的下载协议。", "事件执行失败") MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL 不支持其他乱七八糟的下载协议。", "事件执行失败")
Exit Sub Exit Sub
End If End If
PageOtherTest.StartCustomDownload(Data(0), GetFileNameFromPath(Data(0))) Try
Select Case Data.Length
Case 1
PageOtherTest.StartCustomDownload(Data(0), GetFileNameFromPath(Data(0)))
Case 2
PageOtherTest.StartCustomDownload(Data(0), Data(1))
Case Else
PageOtherTest.StartCustomDownload(Data(0), Data(1), Data(2))
End Select
Catch
PageOtherTest.StartCustomDownload(Data(0), "未知")
End Try
Case Else Case Else
MyMsgBox("未知的事件类型:" & Type & vbCrLf & "请检查事件类型填写是否正确,或者 PCL 是否为最新版本。", "事件执行失败") MyMsgBox("未知的事件类型:" & Type & vbCrLf & "请检查事件类型填写是否正确,或者 PCL 是否为最新版本。", "事件执行失败")
@@ -125,13 +146,11 @@
" - https://www.baidu.com/test.xaml(同时也需要包含这个文件)", ex) " - https://www.baidu.com/test.xaml(同时也需要包含这个文件)", ex)
End Try End Try
'下载文件 '下载文件
Dim LocalTemp1 As String = PathTemp & "CustomEvent\" & RawFileName Dim LocalTemp As String = RequestTaskTempFolder() & RawFileName
Dim LocalTemp2 As String = PathTemp & "CustomEvent\" & RawFileName.Replace(".json", ".xaml") Log("[Event] 转换网络资源:" & RelativeUrl & " -> " & LocalTemp)
Log("[Event] 转换网络资源:" & RelativeUrl & " -> " & LocalTemp1)
Hint("正在获取资源,请稍候……")
Try Try
NetDownload(RelativeUrl, LocalTemp1) NetDownloadByClient(RelativeUrl, LocalTemp)
NetDownload(RelativeUrl.Replace(".json", ".xaml"), LocalTemp1.Replace(".json", ".xaml")) NetDownloadByClient(RelativeUrl.Replace(".json", ".xaml"), LocalTemp.Replace(".json", ".xaml"))
Catch ex As Exception Catch ex As Exception
Throw New Exception("下载指定的文件失败!" & vbCrLf & Throw New Exception("下载指定的文件失败!" & vbCrLf &
"注意,联网帮助页面须指向一个帮助 JSON 文件,并在同路径下包含相应 XAML 文件!" & vbCrLf & "注意,联网帮助页面须指向一个帮助 JSON 文件,并在同路径下包含相应 XAML 文件!" & vbCrLf &
@@ -139,7 +158,7 @@
" - https://www.baidu.com/test.json(填写这个路径)" & vbCrLf & " - https://www.baidu.com/test.json(填写这个路径)" & vbCrLf &
" - https://www.baidu.com/test.xaml(同时也需要包含这个文件)", ex) " - https://www.baidu.com/test.xaml(同时也需要包含这个文件)", ex)
End Try End Try
RelativeUrl = LocalTemp1 RelativeUrl = LocalTemp
End If End If
RelativeUrl = RelativeUrl.Replace("/", "\").ToLower.TrimStart("\") RelativeUrl = RelativeUrl.Replace("/", "\").ToLower.TrimStart("\")
@@ -164,7 +183,7 @@
Location = PathTemp & "Help\" & RelativeUrl Location = PathTemp & "Help\" & RelativeUrl
WorkingDir = PathTemp & "Help\" WorkingDir = PathTemp & "Help\"
Log("[Control] 自定义事件中由相对 PCL 自带帮助文件夹的路径" & EventType & ":" & Location) Log("[Control] 自定义事件中由相对 PCL 自带帮助文件夹的路径" & EventType & ":" & Location)
ElseIf EventType = "打开文件" Then ElseIf EventType = "打开文件" OrElse EventType = "执行命令" Then
'直接使用原有路径启动程序 '直接使用原有路径启动程序
Location = RelativeUrl Location = RelativeUrl
Log("[Control] 自定义事件中直接" & EventType & ":" & Location) Log("[Control] 自定义事件中直接" & EventType & ":" & Location)
+110 -14
View File
@@ -69,14 +69,14 @@ Public Module ModMain
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.Info
TargetColor0 = New MyColor(37, 155, 252) TargetColor0 = New MyColor(215, 37, 155, 252)
TargetColor1 = New MyColor(10, 142, 252) TargetColor1 = New MyColor(215, 10, 142, 252)
Case HintType.Finish Case HintType.Finish
TargetColor0 = New MyColor(33, 177, 33) TargetColor0 = New MyColor(215, 33, 177, 33)
TargetColor1 = New MyColor(29, 160, 29) TargetColor1 = New MyColor(215, 29, 160, 29)
Case Else 'HintType.Critical Case Else 'HintType.Critical
TargetColor0 = New MyColor(255, 53, 11) TargetColor0 = New MyColor(215, 255, 53, 11)
TargetColor1 = New MyColor(255, 43, 0) TargetColor1 = New MyColor(215, 255, 43, 0)
End Select End Select
If Not IsNothing(DoubleStack) Then If Not IsNothing(DoubleStack) Then
'有重复提示,且该提示的进入动画已播放 '有重复提示,且该提示的进入动画已播放
@@ -176,15 +176,17 @@ EndHint:
Public Title As String Public Title As String
Public Text As String Public Text As String
''' <summary> ''' <summary>
''' 输入框模式:文本框的文本;选择模式:需要放进去的 List(Of MyListItem)。 ''' 输入模式:文本框的文本。
''' 选择模式:需要放进去的 List(Of MyListItem)。
''' 登录模式:登录步骤 1 中返回的 JSON。
''' </summary> ''' </summary>
Public Content As Object Public Content As Object
''' <summary> ''' <summary>
''' 仅输入框模式:输入验证规则。 ''' 输入模式:输入验证规则。
''' </summary> ''' </summary>
Public ValidateRules As ObjectModel.Collection(Of Validate) Public ValidateRules As ObjectModel.Collection(Of Validate)
''' <summary> ''' <summary>
''' 仅输入框模式:提示文本。 ''' 输入模式:提示文本。
''' </summary> ''' </summary>
Public HintText As String = "" Public HintText As String = ""
''' <summary> ''' <summary>
@@ -214,7 +216,9 @@ EndHint:
''' </summary> ''' </summary>
Public IsExited As Boolean = False Public IsExited As Boolean = False
''' <summary> ''' <summary>
''' 点击的按钮编号或输入的文本。若输入弹窗点击了非第一个按钮,则为 Nothing。 ''' 输入模式:输入的文本。若点击了 非 第一个按钮,则为 Nothing。
''' 选择模式:点击的按钮编号,从 1 开始。
''' 登录模式:字符串数组 {AccessToken, RefreshToken} 或一个 Exception。
''' </summary> ''' </summary>
Public Result As Object Public Result As Object
End Class End Class
@@ -222,6 +226,7 @@ EndHint:
Text Text
[Select] [Select]
Input Input
Login
End Enum End Enum
''' <summary> ''' <summary>
@@ -352,6 +357,8 @@ EndHint:
FrmMain.PanMsg.Children.Add(New MyMsgSelect(WaitingMyMsgBox(0))) FrmMain.PanMsg.Children.Add(New MyMsgSelect(WaitingMyMsgBox(0)))
Case MyMsgBoxType.Text Case MyMsgBoxType.Text
FrmMain.PanMsg.Children.Add(New MyMsgText(WaitingMyMsgBox(0))) FrmMain.PanMsg.Children.Add(New MyMsgText(WaitingMyMsgBox(0)))
Case MyMsgBoxType.Login
FrmMain.PanMsg.Children.Add(New MyMsgLogin(WaitingMyMsgBox(0)))
End Select End Select
WaitingMyMsgBox.RemoveAt(0) WaitingMyMsgBox.RemoveAt(0)
Else Else
@@ -399,6 +406,7 @@ EndHint:
Public FrmDownloadMod As PageDownloadMod Public FrmDownloadMod As PageDownloadMod
Public FrmDownloadPack As PageDownloadPack Public FrmDownloadPack As PageDownloadPack
Public FrmDownloadShader As PageDownloadShader Public FrmDownloadShader As PageDownloadShader
Public FrmDownloadResourcePack As PageDownloadResourcePack
'设置页面声明 '设置页面声明
Public FrmSetupLeft As PageSetupLeft Public FrmSetupLeft As PageSetupLeft
@@ -428,6 +436,7 @@ EndHint:
Public FrmVersionMod As PageVersionMod Public FrmVersionMod As PageVersionMod
Public FrmVersionModDisabled As PageVersionModDisabled Public FrmVersionModDisabled As PageVersionModDisabled
Public FrmVersionSetup As PageVersionSetup Public FrmVersionSetup As PageVersionSetup
Public FrmVersionExport As PageVersionExport
'资源信息分页声明 '资源信息分页声明
Public FrmDownloadCompDetail As PageDownloadCompDetail Public FrmDownloadCompDetail As PageDownloadCompDetail
@@ -437,6 +446,10 @@ EndHint:
#Region "帮助" #Region "帮助"
Public Class HelpEntry Public Class HelpEntry
''' <summary>
''' 原始信息路径。用于刷新。
''' </summary>
Public RawPath As String
'基础 '基础
@@ -495,6 +508,7 @@ EndHint:
''' 从文件初始化 HelpEntry 对象,失败会抛出异常。 ''' 从文件初始化 HelpEntry 对象,失败会抛出异常。
''' </summary> ''' </summary>
Public Sub New(FilePath As String) Public Sub New(FilePath As String)
RawPath = FilePath
Dim JsonData As JObject = GetJson(HelpArgumentReplace(ReadFile(FilePath))) Dim JsonData As JObject = GetJson(HelpArgumentReplace(ReadFile(FilePath)))
If JsonData Is Nothing Then Throw New FileNotFoundException("未找到帮助文件:" & FilePath, FilePath) If JsonData Is Nothing Then Throw New FileNotFoundException("未找到帮助文件:" & FilePath, FilePath)
'加载常规信息 '加载常规信息
@@ -592,7 +606,7 @@ EndHint:
'加载忽略列表 '加载忽略列表
Log("[Help] 发现 .helpignore 文件:" & File.FullName) Log("[Help] 发现 .helpignore 文件:" & File.FullName)
For Each Line In ReadFile(File.FullName).Split(vbCrLf.ToCharArray) For Each Line In ReadFile(File.FullName).Split(vbCrLf.ToCharArray)
Dim RealString As String = Line.Before("#").Trim Dim RealString As String = Line.BeforeFirst("#").Trim
If String.IsNullOrWhiteSpace(RealString) Then Continue For If String.IsNullOrWhiteSpace(RealString) Then Continue For
IgnoreList.Add(RealString) IgnoreList.Add(RealString)
If ModeDebug Then Log("[Help] > " & RealString) If ModeDebug Then Log("[Help] > " & RealString)
@@ -665,8 +679,8 @@ NextFile:
''' </summary> ''' </summary>
Public Function HelpArgumentReplace(Xaml As String) As String Public Function HelpArgumentReplace(Xaml As String) As String
Dim Result = Xaml.Replace("{path}", EscapeXML(Path)) Dim Result = Xaml.Replace("{path}", EscapeXML(Path))
Result = RegexReplaceEach(Result, Function() EscapeXML(PageOtherTest.GetRandomHint()), "\{hint\}") Result = Result.RegexReplaceEach("\{hint\}", Function() EscapeXML(PageOtherTest.GetRandomHint()))
Result = RegexReplaceEach(Result, Function() EscapeXML(PageOtherTest.GetRandomCave()), "\{cave\}") Result = Result.RegexReplaceEach("\{cave\}", Function() EscapeXML(PageOtherTest.GetRandomCave()))
Return Result Return Result
End Function End Function
@@ -799,7 +813,89 @@ NextFile:
Public Declare Function SetForegroundWindow Lib "user32" (hWnd As IntPtr) As Integer Public Declare Function SetForegroundWindow Lib "user32" (hWnd As IntPtr) As Integer
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (hWnd As IntPtr, msg As UInteger, wParam As Long, lParam As Long) As Boolean Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (hWnd As IntPtr, msg As UInteger, wParam As Long, lParam As Long) As Boolean
Public Declare Function SetDllDirectory Lib "kernel32" Alias "SetDllDirectoryA" (lpPathName As String) As Boolean ''' <summary>
''' 将特定程序设置为使用高性能显卡启动。
''' 如果失败,则抛出异常。
''' </summary>
Public Sub SetGPUPreference(Executeable As String)
Const REG_KEY As String = "Software\Microsoft\DirectX\UserGpuPreferences"
Const REG_VALUE As String = "GpuPreference=2;"
'查看现有设置
Using ReadOnlyKey = My.Computer.Registry.CurrentUser.OpenSubKey(REG_KEY, False)
If ReadOnlyKey IsNot Nothing Then
Dim CurrentValue = ReadOnlyKey.GetValue(Executeable)
If REG_VALUE = CurrentValue?.ToString() Then
Log($"[System] 无需调整显卡设置:{Executeable}")
Return
End If
Else
'创建父级键
Log($"[System] 需要创建显卡设置的父级键")
My.Computer.Registry.CurrentUser.CreateSubKey(REG_KEY)
End If
End Using
'写入新设置
Using WriteKey = My.Computer.Registry.CurrentUser.OpenSubKey(REG_KEY, True)
WriteKey.SetValue(Executeable, REG_VALUE)
Log($"[System] 已调整显卡设置:{Executeable}")
End Using
End Sub
#End Region
#Region "任务缓存"
Private IsTaskTempCleared As Boolean = False
Private IsTaskTempClearing As Boolean = False
''' <summary>
''' 尝试清理任务缓存文件夹。
''' 在整次运行中只会实际清理一次。
''' </summary>
Public Sub TryClearTaskTemp()
If Not IsTaskTempCleared Then
IsTaskTempCleared = True
IsTaskTempClearing = True
Try
Log("[System] 开始清理任务缓存文件夹")
DeleteDirectory($"{OsDrive}ProgramData\PCL\TaskTemp\")
DeleteDirectory($"{PathTemp}TaskTemp\")
Log("[System] 已清理任务缓存文件夹")
Catch ex As Exception
Log(ex, "清理任务缓存文件夹失败")
Finally
IsTaskTempClearing = False
End Try
ElseIf IsTaskTempClearing Then
'等待另一个清理步骤完成
Do While IsTaskTempClearing
Thread.Sleep(1)
Loop
End If
End Sub
''' <summary>
''' 申请一个可用于任务缓存的临时文件夹,以 \ 结尾。这些文件夹无需进行后续清理。
''' 若所有缓存位置均没有权限,会抛出异常。
''' </summary>
''' <param name="RequireNonSpace">是否要求路径不包含空格。</param>
Public Function RequestTaskTempFolder(Optional RequireNonSpace As Boolean = False) As String
TryClearTaskTemp()
Dim ResultFolder As String
Try
ResultFolder = $"{PathTemp}TaskTemp\{GetUuid()}-{RandomInteger(0, 1000000)}\"
If RequireNonSpace AndAlso ResultFolder.Contains(" ") Then Exit Try '带空格
Directory.CreateDirectory(ResultFolder)
CheckPermissionWithException(ResultFolder)
Return ResultFolder
Catch
End Try
'使用备用路径
ResultFolder = $"{OsDrive}ProgramData\PCL\TaskTemp\{GetUuid()}-{RandomInteger(0, 1000000)}\"
Directory.CreateDirectory(ResultFolder)
CheckPermission(ResultFolder)
Return ResultFolder
End Function
#End Region #End Region
+86 -55
View File
@@ -14,8 +14,8 @@
''' 初始化音乐播放列表。 ''' 初始化音乐播放列表。
''' </summary> ''' </summary>
''' <param name="ForceReload">强制全部重新载入列表。</param> ''' <param name="ForceReload">强制全部重新载入列表。</param>
''' <param name="IgnoreFirst">在重载列表时避免让某项成为第一项。</param> ''' <param name="PreventFirst">在重载列表时避免让某项成为第一项。</param>
Private Sub MusicListInit(ForceReload As Boolean, Optional IgnoreFirst As String = "") Private Sub MusicListInit(ForceReload As Boolean, Optional PreventFirst As String = Nothing)
If ForceReload Then MusicAllList = Nothing If ForceReload Then MusicAllList = Nothing
Try Try
'初始化全部可用音乐列表 '初始化全部可用音乐列表
@@ -31,10 +31,10 @@
End If End If
'打乱顺序播放 '打乱顺序播放
MusicWaitingList = If(Setup.Get("UiMusicRandom"), Shuffle(New List(Of String)(MusicAllList)), New List(Of String)(MusicAllList)) MusicWaitingList = If(Setup.Get("UiMusicRandom"), Shuffle(New List(Of String)(MusicAllList)), New List(Of String)(MusicAllList))
If Not IgnoreFirst = "" AndAlso Not Not MusicWaitingList.Any() AndAlso MusicWaitingList(0) = IgnoreFirst Then If PreventFirst IsNot Nothing AndAlso MusicWaitingList.FirstOrDefault = PreventFirst Then
'若需要避免成为第一项的为第一项,则将它放在最后 '若需要避免成为第一项的为第一项,则将它放在最后
MusicWaitingList.RemoveAt(0) MusicWaitingList.RemoveAt(0)
MusicWaitingList.Add(IgnoreFirst) MusicWaitingList.Add(PreventFirst)
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "初始化音乐列表失败", LogLevel.Feedback) Log(ex, "初始化音乐列表失败", LogLevel.Feedback)
@@ -42,13 +42,18 @@
End Sub End Sub
''' <summary> ''' <summary>
''' 获取下一首播放的音乐路径并将其从列表中移除。 ''' 获取下一首播放的音乐路径并将其从列表中移除。
''' 如果没有,可能会返回 Nothing。
''' </summary> ''' </summary>
Private Function DequeueNextMusicAddress() As String Private Function DequeueNextMusicAddress() As String
'初始化,确保存在音乐 '初始化,确保存在音乐
If MusicAllList Is Nothing OrElse Not MusicAllList.Any() OrElse Not MusicWaitingList.Any() Then MusicListInit(False) If MusicAllList Is Nothing OrElse Not MusicAllList.Any() OrElse Not MusicWaitingList.Any() Then MusicListInit(False)
'出列下一个音乐,如果出列结束则生成新列表 '出列下一个音乐,如果出列结束则生成新列表
DequeueNextMusicAddress = MusicWaitingList(0) If MusicWaitingList.Any() Then
MusicWaitingList.RemoveAt(0) DequeueNextMusicAddress = MusicWaitingList(0)
MusicWaitingList.RemoveAt(0)
Else
DequeueNextMusicAddress = Nothing
End If
If Not MusicWaitingList.Any() Then MusicListInit(False, DequeueNextMusicAddress) If Not MusicWaitingList.Any() Then MusicListInit(False, DequeueNextMusicAddress)
End Function End Function
@@ -60,44 +65,45 @@
''' 刷新背景音乐按钮 UI 与设置页 UI。 ''' 刷新背景音乐按钮 UI 与设置页 UI。
''' </summary> ''' </summary>
Private Sub MusicRefreshUI() Private Sub MusicRefreshUI()
RunInUi(Sub() RunInUi(
Try Sub()
Try
If Not MusicAllList.Any() Then If Not MusicAllList.Any() Then
'无背景音乐 '无背景音乐
FrmMain.BtnExtraMusic.Show = False FrmMain.BtnExtraMusic.Show = False
Else
'有背景音乐
FrmMain.BtnExtraMusic.Show = True
Dim ToolTipText As String
If MusicState = MusicStates.Pause Then
FrmMain.BtnExtraMusic.Logo = Logo.IconPlay
FrmMain.BtnExtraMusic.LogoScale = 0.8
ToolTipText = "已暂停:" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
If MusicAllList.Count > 1 Then
ToolTipText += vbCrLf & "左键恢复播放,右键播放下一曲。"
Else Else
'有背景音乐 ToolTipText += vbCrLf & "左键恢复播放,右键重新从头播放。"
FrmMain.BtnExtraMusic.Show = True
Dim ToolTipText As String
If MusicState = MusicStates.Pause Then
FrmMain.BtnExtraMusic.Logo = Logo.IconPlay
FrmMain.BtnExtraMusic.LogoScale = 0.8
ToolTipText = "已暂停:" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
If MusicAllList.Count > 1 Then
ToolTipText += vbCrLf & "左键恢复播放,右键播放下一曲。"
Else
ToolTipText += vbCrLf & "左键恢复播放,右键重新从头播放。"
End If
Else
FrmMain.BtnExtraMusic.Logo = Logo.IconMusic
FrmMain.BtnExtraMusic.LogoScale = 1
ToolTipText = "正在播放:" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
If MusicAllList.Count > 1 Then
ToolTipText += vbCrLf & "左键暂停,右键播放下一曲。"
Else
ToolTipText += vbCrLf & "左键暂停,右键重新从头播放。"
End If
End If
FrmMain.BtnExtraMusic.ToolTip = ToolTipText
ToolTipService.SetVerticalOffset(FrmMain.BtnExtraMusic, If(ToolTipText.Contains(vbLf), 10, 16))
End If End If
If FrmSetupUI IsNot Nothing Then FrmSetupUI.MusicRefreshUI() Else
FrmMain.BtnExtraMusic.Logo = Logo.IconMusic
FrmMain.BtnExtraMusic.LogoScale = 1
ToolTipText = "正在播放:" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
If MusicAllList.Count > 1 Then
ToolTipText += vbCrLf & "左键暂停,右键播放下一曲。"
Else
ToolTipText += vbCrLf & "左键暂停,右键重新从头播放。"
End If
End If
FrmMain.BtnExtraMusic.ToolTip = ToolTipText
ToolTipService.SetVerticalOffset(FrmMain.BtnExtraMusic, If(ToolTipText.Contains(vbLf), 10, 16))
End If
If FrmSetupUI IsNot Nothing Then FrmSetupUI.MusicRefreshUI()
Catch ex As Exception Catch ex As Exception
Log(ex, "刷新背景音乐 UI 失败", LogLevel.Feedback) Log(ex, "刷新背景音乐 UI 失败", LogLevel.Feedback)
End Try End Try
End Sub) End Sub)
End Sub End Sub
''' <summary> ''' <summary>
@@ -128,8 +134,12 @@
Hint("重新播放:" & GetFileNameFromPath(MusicCurrent), HintType.Finish) Hint("重新播放:" & GetFileNameFromPath(MusicCurrent), HintType.Finish)
Else Else
Dim Address As String = DequeueNextMusicAddress() Dim Address As String = DequeueNextMusicAddress()
MusicStartPlay(Address) If Address Is Nothing Then
Hint("正在播放:" & GetFileNameFromPath(Address), HintType.Finish) Hint("没有可以播放的音乐!", HintType.Critical)
Else
MusicStartPlay(Address)
Hint("正在播放:" & GetFileNameFromPath(Address), HintType.Finish)
End If
End If End If
MusicRefreshUI() MusicRefreshUI()
End Sub End Sub
@@ -179,11 +189,15 @@
End If End If
Else Else
Dim Address As String = DequeueNextMusicAddress() Dim Address As String = DequeueNextMusicAddress()
Try If Address Is Nothing Then
MusicStartPlay(Address, IsFirstLoad) If ShowHint Then Hint("没有可以播放的音乐!", HintType.Critical)
If ShowHint Then Hint("背景音乐已刷新:" & GetFileNameFromPath(Address), HintType.Finish, False) Else
Catch Try
End Try MusicStartPlay(Address, IsFirstLoad)
If ShowHint Then Hint("背景音乐已刷新:" & GetFileNameFromPath(Address), HintType.Finish, False)
Catch
End Try
End If
End If End If
MusicRefreshUI() MusicRefreshUI()
@@ -195,6 +209,7 @@
''' 开始播放音乐。 ''' 开始播放音乐。
''' </summary> ''' </summary>
Private Sub MusicStartPlay(Address As String, Optional IsFirstLoad As Boolean = False) Private Sub MusicStartPlay(Address As String, Optional IsFirstLoad As Boolean = False)
If Address Is Nothing Then Return
Log("[Music] 播放开始:" & Address) Log("[Music] 播放开始:" & Address)
MusicCurrent = Address MusicCurrent = Address
RunInNewThread(Sub() MusicLoop(IsFirstLoad), "Music", ThreadPriority.BelowNormal) RunInNewThread(Sub() MusicLoop(IsFirstLoad), "Music", ThreadPriority.BelowNormal)
@@ -230,7 +245,12 @@
RunInThread( RunInThread(
Sub() Sub()
Log("[Music] 已恢复播放") Log("[Music] 已恢复播放")
MusicNAudio?.Play() Try
MusicNAudio?.Play()
Catch 'https://github.com/Hex-Dragon/PCL2/pull/5415#issuecomment-2751135223
MusicNAudio?.Stop()
MusicNAudio?.Play()
End Try
MusicRefreshUI() MusicRefreshUI()
End Sub) End Sub)
Return True Return True
@@ -240,7 +260,7 @@
#End Region #End Region
''' <summary> ''' <summary>
''' 当前正在播放的 NAudio.Wave.WaveOut。 ''' 当前正在播放的 NAudio.Wave.WaveOutEvent。
''' </summary> ''' </summary>
Public MusicNAudio = Nothing Public MusicNAudio = Nothing
''' <summary> ''' <summary>
@@ -252,12 +272,13 @@
''' 在 MusicUuid 不变的前提下,持续播放某地址的音乐,且在播放结束后随机播放下一曲。 ''' 在 MusicUuid 不变的前提下,持续播放某地址的音乐,且在播放结束后随机播放下一曲。
''' </summary> ''' </summary>
Private Sub MusicLoop(Optional IsFirstLoad As Boolean = False) Private Sub MusicLoop(Optional IsFirstLoad As Boolean = False)
Dim CurrentWave As NAudio.Wave.WaveOut = Nothing Dim CurrentWave As NAudio.Wave.WaveOutEvent = Nothing
Dim Reader As NAudio.Wave.WaveStream = Nothing Dim Reader As NAudio.Wave.WaveStream = Nothing
Try Try
'开始播放 '开始播放
CurrentWave = New NAudio.Wave.WaveOut() CurrentWave = New NAudio.Wave.WaveOutEvent()
MusicNAudio = CurrentWave MusicNAudio = CurrentWave
CurrentWave.DeviceNumber = -1
Reader = New NAudio.Wave.AudioFileReader(MusicCurrent) Reader = New NAudio.Wave.AudioFileReader(MusicCurrent)
CurrentWave.Init(Reader) CurrentWave.Init(Reader)
CurrentWave.Play() CurrentWave.Play()
@@ -280,22 +301,32 @@
'当前音乐已播放结束,继续下一曲 '当前音乐已播放结束,继续下一曲
If CurrentWave.PlaybackState = NAudio.Wave.PlaybackState.Stopped AndAlso MusicAllList.Any Then MusicStartPlay(DequeueNextMusicAddress) If CurrentWave.PlaybackState = NAudio.Wave.PlaybackState.Stopped AndAlso MusicAllList.Any Then MusicStartPlay(DequeueNextMusicAddress)
Catch ex As Exception Catch ex As Exception
Log("[Music] 播放音乐失败的文件完整路径:" & MusicCurrent) Log(ex, "播放音乐出现内部错误(" & MusicCurrent & ")", LogLevel.Developer)
If TypeOf ex Is NAudio.MmException AndAlso ex.Message.Contains("AlreadyAllocated") Then
Hint("你的音频设备正被其他程序占用。请在关闭占用的程序后重启 PCL,才能恢复音乐播放功能!", HintType.Critical)
Thread.Sleep(1000000000)
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.Critical)
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 ex.Message.Contains("Got a frame at sample rate") OrElse ex.Message.Contains("does not support changes to") Then
Hint("播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & "):PCL 不支持播放音频属性在中途发生变化的音乐", HintType.Critical) Hint("播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & "):PCL 不支持播放音频属性在中途发生变化的音乐", HintType.Critical)
ElseIf Not (MusicCurrent.EndsWithF(".wav", True) OrElse MusicCurrent.EndsWithF(".mp3", True) OrElse MusicCurrent.EndsWithF(".flac", True)) Then 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)
Hint("播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & "):PCL 可能不支持此音乐格式,请将格式转换为 .wav、.mp3 或 .flac 后再试", HintType.Critical) Hint("播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & "):PCL 可能不支持此音乐格式,请将格式转换为 .wav、.mp3 或 .flac 后再试", HintType.Critical)
Else Else
Log(ex, "播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & ")", LogLevel.Hint) Log(ex, "播放音乐失败(" & GetFileNameFromPath(MusicCurrent) & ")", LogLevel.Hint)
End If End If
Thread.Sleep(1000) '将播放错误的音乐从列表中移除
MusicAllList.Remove(MusicCurrent)
MusicWaitingList.Remove(MusicCurrent)
MusicRefreshUI()
'等待 2 秒后继续播放
Thread.Sleep(2000)
If TypeOf ex Is FileNotFoundException Then If TypeOf ex Is FileNotFoundException Then
MusicRefreshPlay(True, IsFirstLoad) MusicRefreshPlay(True, IsFirstLoad)
ElseIf MusicAllList.Count > 1 Then Else
MusicStartPlay(DequeueNextMusicAddress(), IsFirstLoad) MusicStartPlay(DequeueNextMusicAddress(), IsFirstLoad)
End If End If
Finally Finally
+25 -18
View File
@@ -1,17 +1,17 @@
'由于包含加解密等安全信息,本文件中的部分代码已被删除 '由于包含加解密等安全信息,本文件中的部分代码已被删除
Imports System.Net
Imports System.Reflection
Imports System.Security.Cryptography Imports System.Security.Cryptography
Friend Module ModSecret Friend Module ModSecret
#Region "杂项" #Region "杂项"
'在开源内容的注册表键与普通内容的注册表键隔离 '在开源版的注册表与常规版的注册表隔离,以防数据冲突
Public Const RegFolder As String = "PCLDebug" Public Const RegFolder As String = "PCLDebug"
'用于微软登录的 ClientId '用于微软登录的 ClientId
Public Const OAuthClientId As String = "" Public Const OAuthClientId As String = ""
'CurseForge API Key
Public Const CurseForgeAPIKey As String = ""
Friend Sub SecretOnApplicationStart() Friend Sub SecretOnApplicationStart()
'提升 UI 线程优先级 '提升 UI 线程优先级
@@ -32,7 +32,7 @@ Friend Module ModSecret
"2. 删除当前目录中的 PCL 文件夹,然后再试。" & vbCrLf & "2. 删除当前目录中的 PCL 文件夹,然后再试。" & vbCrLf &
"3. 右键 PCL 选择属性,打开 兼容性 中的 以管理员身份运行此程序。", "3. 右键 PCL 选择属性,打开 兼容性 中的 以管理员身份运行此程序。",
MsgBoxStyle.Critical, "运行环境错误") MsgBoxStyle.Critical, "运行环境错误")
Environment.[Exit](Result.Cancel) Environment.[Exit](ProcessReturnValues.Cancel)
End Try End Try
If Not CheckPermission(Path & "PCL") Then If Not CheckPermission(Path & "PCL") Then
MsgBox("PCL 没有对当前文件夹的写入权限,请尝试:" & vbCrLf & MsgBox("PCL 没有对当前文件夹的写入权限,请尝试:" & vbCrLf &
@@ -40,11 +40,11 @@ Friend Module ModSecret
"2. 删除当前目录中的 PCL 文件夹,然后再试。" & vbCrLf & "2. 删除当前目录中的 PCL 文件夹,然后再试。" & vbCrLf &
"3. 右键 PCL 选择属性,打开 兼容性 中的 以管理员身份运行此程序。", "3. 右键 PCL 选择属性,打开 兼容性 中的 以管理员身份运行此程序。",
MsgBoxStyle.Critical, "运行环境错误") MsgBoxStyle.Critical, "运行环境错误")
Environment.[Exit](Result.Cancel) Environment.[Exit](ProcessReturnValues.Cancel)
End If End If
'开源版本提示 '开源版本提示
MyMsgBox($"该版本中无法使用以下特性: MyMsgBox($"该版本中无法使用以下特性:
- CurseForge API 调用:需要你自行申请 API Key,然后添加到 SecretHeadersSign 方法中 - CurseForge API 调用:需要你自行申请 API Key,然后添加到 ModSecret.vb 的开头
- 正版登录:需要你自行申请 Client ID,然后添加到 ModSecret.vb 的开头 - 正版登录:需要你自行申请 Client ID,然后添加到 ModSecret.vb 的开头
- 更新与联网通知:避免滥用隐患 - 更新与联网通知:避免滥用隐患
- 主题切换:这是需要赞助解锁的纪念性质的功能,别让赞助者太伤心啦…… - 主题切换:这是需要赞助解锁的纪念性质的功能,别让赞助者太伤心啦……
@@ -99,29 +99,29 @@ Friend Module ModSecret
''' 设置 Headers 的 UA、Referer。 ''' 设置 Headers 的 UA、Referer。
''' </summary> ''' </summary>
Friend Sub SecretHeadersSign(Url As String, ByRef Client As WebClient, Optional UseBrowserUserAgent As Boolean = False) Friend Sub SecretHeadersSign(Url As String, ByRef Client As WebClient, Optional UseBrowserUserAgent As Boolean = False)
If Url.Contains("modrinth.com") Then '根据 #4334,不添加 PCL 的 UA 反而能正常访问 If Url.Contains("baidupcs.com") OrElse Url.Contains("baidu.com") Then
Client.Headers("User-Agent") = "Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36" Client.Headers("User-Agent") = "LogStatistic" '#4951
ElseIf UseBrowserUserAgent Then ElseIf UseBrowserUserAgent Then
Client.Headers("User-Agent") = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36" Client.Headers("User-Agent") = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
Else Else
Client.Headers("User-Agent") = "PCL2/" & VersionStandardCode Client.Headers("User-Agent") = "PCL2/" & VersionStandardCode
End If End If
Client.Headers("Referer") = "http://" & VersionCode & ".pcl2.open.server/" Client.Headers("Referer") = "http://" & VersionCode & ".open.pcl2.server/"
'如果你有 CurseForge API Key,请添加到 Headers 中,以恢复对 CurseForge 的访问 If Url.Contains("api.curseforge.com") Then Client.Headers("x-api-key") = CurseForgeAPIKey
End Sub End Sub
''' <summary> ''' <summary>
''' 设置 Headers 的 UA、Referer。 ''' 设置 Headers 的 UA、Referer。
''' </summary> ''' </summary>
Friend Sub SecretHeadersSign(Url As String, ByRef Request As HttpWebRequest, Optional UseBrowserUserAgent As Boolean = False) Friend Sub SecretHeadersSign(Url As String, ByRef Request As HttpWebRequest, Optional UseBrowserUserAgent As Boolean = False)
If Url.Contains("modrinth.com") Then '根据 #4334,不添加 PCL 的 UA 反而能正常访问 If Url.Contains("baidupcs.com") OrElse Url.Contains("baidu.com") Then
Request.UserAgent = "Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36" Request.UserAgent = "LogStatistic" '#4951
ElseIf UseBrowserUserAgent Then ElseIf UseBrowserUserAgent Then
Request.UserAgent = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36" Request.UserAgent = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
Else Else
Request.UserAgent = "PCL2/" & VersionStandardCode Request.UserAgent = "PCL2/" & VersionStandardCode
End If End If
Request.Referer = "http://" & VersionCode & ".pcl2.open.server/" Request.Referer = "http://" & VersionCode & ".open.pcl2.server/"
'如果你有 CurseForge API Key,请添加到 Headers 中,以恢复对 CurseForge 的访问 If Url.Contains("api.curseforge.com") Then Request.Headers("x-api-key") = CurseForgeAPIKey
End Sub End Sub
#End Region #End Region
@@ -244,18 +244,18 @@ Friend Module ModSecret
FrmMain.PanForm.Background.Freeze() FrmMain.PanForm.Background.Freeze()
End Sub) End Sub)
End Sub End Sub
Public Sub ThemeCheckAll(EffectSetup As Boolean) Friend Sub ThemeCheckAll(EffectSetup As Boolean)
End Sub End Sub
Public Function ThemeCheckOne(Id As Integer) As Boolean Friend Function ThemeCheckOne(Id As Integer) As Boolean
Return True Return True
End Function End Function
Friend Function ThemeUnlock(Id As Integer, Optional ShowDoubleHint As Boolean = True, Optional UnlockHint As String = Nothing) As Boolean Friend Function ThemeUnlock(Id As Integer, Optional ShowDoubleHint As Boolean = True, Optional UnlockHint As String = Nothing) As Boolean
Return False Return False
End Function End Function
Public Function ThemeCheckGold(Optional Code As String = Nothing) As Boolean Friend Function ThemeCheckGold(Optional Code As String = Nothing) As Boolean
Return False Return False
End Function End Function
Public Function DonateCodeInput() As Boolean? Friend Function DonateCodeInput() As Boolean?
Return Nothing Return Nothing
End Function End Function
@@ -274,6 +274,13 @@ Friend Module ModSecret
End Sub End Sub
Public Sub UpdateReplace(ProcessId As Integer, OldFileName As String, NewFileName As String, TriggerRestart As Boolean) Public Sub UpdateReplace(ProcessId As Integer, OldFileName As String, NewFileName As String, TriggerRestart As Boolean)
End Sub End Sub
''' <summary>
''' 确保 PathTemp 下的 Latest.exe 是最新正式版的 PCL,它会被用于整合包打包。
''' 如果不是,则下载一个。
''' </summary>
Friend Sub DownloadLatestPCL(Optional LoaderToSyncProgress As LoaderBase = Nothing)
'注意:如果要自行实现这个功能,请换用另一个文件路径,以免与官方版本冲突
End Sub
#End Region #End Region
@@ -1,4 +1,4 @@
Imports System.Reflection Imports System.Reflection
Imports System.Resources Imports System.Resources
Imports System.Runtime.InteropServices Imports System.Runtime.InteropServices
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号 ' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*” ' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.8.6.0")> <Assembly: AssemblyVersion("2.9.3.0")>
<Assembly: AssemblyFileVersion("2.8.6.0")> <Assembly: AssemblyFileVersion("2.9.3.0")>
<Assembly: NeutralResourcesLanguage("")> <Assembly: NeutralResourcesLanguage("")>
+10 -20
View File
@@ -100,6 +100,16 @@ Namespace My.Resources
End Get End Get
End Property End Property
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
Friend ReadOnly Property Imazen_WebP() As Byte()
Get
Dim obj As Object = ResourceManager.GetObject("Imazen_WebP", resourceCulture)
Return CType(obj,Byte())
End Get
End Property
'''<summary> '''<summary>
''' 查找 System.Byte[] 类型的本地化资源。 ''' 查找 System.Byte[] 类型的本地化资源。
'''</summary> '''</summary>
@@ -120,16 +130,6 @@ Namespace My.Resources
End Get End Get
End Property End Property
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
Friend ReadOnly Property libwebp32() As Byte()
Get
Dim obj As Object = ResourceManager.GetObject("libwebp32", resourceCulture)
Return CType(obj,Byte())
End Get
End Property
'''<summary> '''<summary>
''' 查找 System.Byte[] 类型的本地化资源。 ''' 查找 System.Byte[] 类型的本地化资源。
'''</summary> '''</summary>
@@ -169,15 +169,5 @@ Namespace My.Resources
Return CType(obj,Byte()) Return CType(obj,Byte())
End Get End Get
End Property End Property
'''<summary>
''' 查找 System.Byte[] 类型的本地化资源。
'''</summary>
Friend ReadOnly Property WebP() As Byte()
Get
Dim obj As Object = ResourceManager.GetObject("WebP", resourceCulture)
Return CType(obj,Byte())
End Get
End Property
End Module End Module
End Namespace End Namespace
@@ -130,15 +130,15 @@
<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">
<value>..\Resources\Imazen.WebP.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</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"> <data name="Json" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\Newtonsoft.Json.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> <value>..\Resources\Newtonsoft.Json.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data> </data>
<data name="libwebp32" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\libwebp32.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
<data name="libwebp64" type="System.Resources.ResXFileRef, System.Windows.Forms"> <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>
@@ -151,7 +151,4 @@
<data name="Transformer" type="System.Resources.ResXFileRef, System.Windows.Forms"> <data name="Transformer" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\transformer.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> <value>..\Resources\transformer.jar;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data> </data>
<data name="WebP" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\Imazen.WebP.dll;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data>
</root> </root>
@@ -1,4 +1,5 @@
Imports System.IO.Compression Imports System.IO.Compression
Imports System.Net.Http
Public Module ModDownloadLib Public Module ModDownloadLib
@@ -28,7 +29,7 @@ Public Module ModDownloadLib
Dim VersionFolder As String = PathMcFolder & "versions\" & Id & "\" Dim VersionFolder As String = PathMcFolder & "versions\" & Id & "\"
'重复任务检查 '重复任务检查
For Each OngoingLoader In LoaderTaskbar For Each OngoingLoader In LoaderTaskbar.ToList()
If OngoingLoader.Name <> $"Minecraft {Id} 下载" Then Continue For If OngoingLoader.Name <> $"Minecraft {Id} 下载" Then Continue For
If Behaviour = NetPreDownloadBehaviour.ExitWhileExistsOrDownloading Then Return OngoingLoader If Behaviour = NetPreDownloadBehaviour.ExitWhileExistsOrDownloading Then Return OngoingLoader
Hint("该版本正在下载中!", HintType.Critical) Hint("该版本正在下载中!", HintType.Critical)
@@ -59,47 +60,6 @@ Public Module ModDownloadLib
Return Nothing Return Nothing
End Try End Try
End Function End Function
''' <summary>
''' 保存某个 Minecraft 版本的核心文件(仅 Json 与核心 Jar)。
''' </summary>
''' <param name="Id">所下载的 Minecraft 的版本名。</param>
''' <param name="JsonUrl">Json 文件的 Mojang 官方地址。</param>
Public Sub McDownloadClientCore(Id As String, JsonUrl As String, Behaviour As NetPreDownloadBehaviour)
Try
Dim VersionFolder As String = SelectFolder()
If Not VersionFolder.Contains("\") Then Exit Sub
VersionFolder = VersionFolder & Id & "\"
'重复任务检查
For Each OngoingLoader In LoaderTaskbar
If OngoingLoader.Name <> $"Minecraft {Id} 下载" Then Continue For
If Behaviour = NetPreDownloadBehaviour.ExitWhileExistsOrDownloading Then Exit Sub
Hint("该版本正在下载中!", HintType.Critical)
Exit Sub
Next
Dim Loaders As New List(Of LoaderBase)
'下载版本 Json 文件
Loaders.Add(New LoaderDownload("下载版本 json 文件", New List(Of NetFile) From {
New NetFile(DlSourceLauncherOrMetaGet(JsonUrl), VersionFolder & Id & ".json", New FileChecker(CanUseExistsFile:=False, IsJson:=True))
}) With {.ProgressWeight = 2})
'获取支持库文件地址
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析核心 jar 文件下载地址",
Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionFolder), True)) With {.ProgressWeight = 0.5, .Show = False})
'下载支持库文件
Loaders.Add(New LoaderDownload("下载核心 jar 文件", New List(Of NetFile)) With {.ProgressWeight = 5})
'启动
Dim Loader As New LoaderCombo(Of String)("Minecraft " & Id & " 下载", Loaders) With {.OnStateChanged = AddressOf DownloadStateSave}
Loader.Start(Id)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "开始 Minecraft 下载失败", LogLevel.Feedback)
End Try
End Sub
''' <summary> ''' <summary>
''' 获取下载某个 Minecraft 版本的加载器列表。 ''' 获取下载某个 Minecraft 版本的加载器列表。
@@ -127,6 +87,7 @@ Public Module ModDownloadLib
Dim LoadersLib As New List(Of LoaderBase) Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析原版支持库文件(副加载器)", LoadersLib.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)))
Thread.Sleep(50) '等待 JSON 文件实际写入硬盘(#3710)
Log("[Download] 开始分析原版支持库文件:" & VersionFolder) Log("[Download] 开始分析原版支持库文件:" & VersionFolder)
Task.Output = McLibFix(New McVersion(VersionFolder)) Task.Output = McLibFix(New McVersion(VersionFolder))
End Sub) With {.ProgressWeight = 1, .Show = False}) End Sub) With {.ProgressWeight = 1, .Show = False})
@@ -155,7 +116,7 @@ Public Module ModDownloadLib
LoadersAssets.Add(New LoaderDownload("下载资源文件索引(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 3, .Show = False}) LoadersAssets.Add(New LoaderDownload("下载资源文件索引(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 3, .Show = False})
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)))
Task.Output = McAssetsFixList(McAssetsGetIndexName(New McVersion(VersionFolder)), True, Task) Task.Output = McAssetsFixList(New McVersion(VersionFolder), True, Task)
End Sub) With {.ProgressWeight = 3, .Show = False}) End Sub) With {.ProgressWeight = 3, .Show = False})
LoadersAssets.Add(New LoaderDownload("下载资源文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 14, .Show = False}) LoadersAssets.Add(New LoaderDownload("下载资源文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 14, .Show = False})
Loaders.Add(New LoaderCombo(Of String)("下载原版资源文件", LoadersAssets) With {.Block = False, .ProgressWeight = 21}) Loaders.Add(New LoaderCombo(Of String)("下载原版资源文件", LoadersAssets) With {.Block = False, .ProgressWeight = 21})
@@ -207,7 +168,12 @@ Public Module ModDownloadLib
ToolTipService.SetVerticalOffset(BtnInfo, 30) ToolTipService.SetVerticalOffset(BtnInfo, 30)
ToolTipService.SetHorizontalOffset(BtnInfo, 2) ToolTipService.SetHorizontalOffset(BtnInfo, 2)
AddHandler BtnInfo.Click, AddressOf McDownloadMenuLog AddHandler BtnInfo.Click, AddressOf McDownloadMenuLog
sender.Buttons = {BtnInfo} Dim BtnServer As New MyIconButton With {.LogoScale = 1, .Logo = Logo.IconButtonServer, .ToolTip = "下载服务端"}
ToolTipService.SetPlacement(BtnServer, Primitives.PlacementMode.Center)
ToolTipService.SetVerticalOffset(BtnServer, 30)
ToolTipService.SetHorizontalOffset(BtnServer, 2)
AddHandler BtnServer.Click, AddressOf McDownloadMenuSaveServer
sender.Buttons = {BtnServer, BtnInfo}
End Sub End Sub
Private Sub McDownloadMenuBuild(sender As Object, e As EventArgs) Private Sub McDownloadMenuBuild(sender As Object, e As EventArgs)
Dim BtnSave As New MyIconButton With {.Logo = Logo.IconButtonSave, .ToolTip = "另存为"} Dim BtnSave As New MyIconButton With {.Logo = Logo.IconButtonSave, .ToolTip = "另存为"}
@@ -220,7 +186,12 @@ Public Module ModDownloadLib
ToolTipService.SetVerticalOffset(BtnInfo, 30) ToolTipService.SetVerticalOffset(BtnInfo, 30)
ToolTipService.SetHorizontalOffset(BtnInfo, 2) ToolTipService.SetHorizontalOffset(BtnInfo, 2)
AddHandler BtnInfo.Click, AddressOf McDownloadMenuLog AddHandler BtnInfo.Click, AddressOf McDownloadMenuLog
sender.Buttons = {BtnSave, BtnInfo} Dim BtnServer As New MyIconButton With {.LogoScale = 1, .Logo = Logo.IconButtonServer, .ToolTip = "下载服务端"}
ToolTipService.SetPlacement(BtnServer, Primitives.PlacementMode.Center)
ToolTipService.SetVerticalOffset(BtnServer, 30)
ToolTipService.SetHorizontalOffset(BtnServer, 2)
AddHandler BtnServer.Click, AddressOf McDownloadMenuSaveServer
sender.Buttons = {BtnSave, BtnInfo, BtnServer}
End Sub End Sub
Private Sub McDownloadMenuLog(sender As Object, e As RoutedEventArgs) Private Sub McDownloadMenuLog(sender As Object, e As RoutedEventArgs)
Dim Version As JToken Dim Version As JToken
@@ -233,6 +204,83 @@ Public Module ModDownloadLib
End If End If
McUpdateLogShow(Version) McUpdateLogShow(Version)
End Sub End Sub
Private Sub McDownloadMenuSaveServer(sender As Object, e As RoutedEventArgs)
Dim Version As MyListItem
If TypeOf sender Is MyListItem Then
Version = sender
ElseIf TypeOf sender.Parent Is MyListItem Then
Version = sender.Parent
Else
Version = sender.Parent.Parent
End If
Try
Dim Id = Version.Title
Dim JsonUrl = Version.Tag("url").ToString
Dim VersionFolder As String = SelectFolder()
If Not VersionFolder.Contains("\") Then Exit Sub
VersionFolder = VersionFolder & Id & "\"
'重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList()
If OngoingLoader.Name <> $"Minecraft {Id} 服务端下载" Then Continue For
Hint("该服务端正在下载中!", HintType.Critical)
Exit Sub
Next
Dim Loaders As New List(Of LoaderBase)
'下载版本 JSON 文件
Loaders.Add(New LoaderDownload("下载版本 JSON 文件", New List(Of NetFile) From {
New NetFile(DlSourceLauncherOrMetaGet(JsonUrl), VersionFolder & Id & ".json", New FileChecker(CanUseExistsFile:=False, IsJson:=True))
}) With {.ProgressWeight = 2})
'构建服务端
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("构建服务端",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
'分析服务端 JAR 文件下载地址
Dim McVersion As New McVersion(VersionFolder)
If McVersion.JsonObject("downloads") Is Nothing OrElse McVersion.JsonObject("downloads")("server") Is Nothing OrElse McVersion.JsonObject("downloads")("server")("url") Is Nothing Then
File.Delete(VersionFolder & Id & ".json")
If Not New DirectoryInfo(VersionFolder).GetFileSystemInfos.Any() Then Directory.Delete(VersionFolder)
Task.Output = New List(Of NetFile)
Hint($"Mojang 没有给 Minecraft {Id} 提供官方服务端下载,没法下,撤退!", HintType.Critical)
Thread.Sleep(2000) '等玩家把上一个提示看完
Task.Abort()
Exit Sub
End If
Dim JarUrl As String = McVersion.JsonObject("downloads")("server")("url")
Dim Checker As New FileChecker(MinSize:=1024, ActualSize:=If(McVersion.JsonObject("downloads")("server")("size"), -1), Hash:=McVersion.JsonObject("downloads")("server")("sha1"))
Task.Output = New List(Of NetFile) From {New NetFile(DlSourceLauncherOrMetaGet(JarUrl), VersionFolder & Id & "-server.jar", Checker)}
'添加启动脚本
Dim Bat As String =
$"@echo off
title {Id} 原版服务端
echo 如果服务端立即停止,请右键编辑该脚本,将下一行开头的 java 替换为适合该 Minecraft 版本的完整 java.exe 的路径。
echo 你可以在 PCL 的 [设置 → 启动选项] 中查看已安装的 java,所需的 java.exe 一般在其中的 bin 文件夹下。
echo ------------------------------
echo 如果提示 ""You need to agree to the EULA in order to run the server"",请打开 eula.txt,按说明阅读并同意 Minecraft EULA 后,将该文件最后一行中的 eula=false 改为 eula=true。
echo ------------------------------
""java"" -server -XX:+UseG1GC -Xmx4096M -Xms1024M -XX:+UseCompressedOops -jar {Id}-server.jar nogui
echo ----------------------
echo 服务端已停止。
pause"
WriteFile(VersionFolder & "Launch Server.bat", Bat,
Encoding:=If(Encoding.Default.Equals(Encoding.UTF8), Encoding.UTF8, Encoding.GetEncoding("GB18030")))
'删除版本 JSON
File.Delete(VersionFolder & Id & ".json")
End Sub
) With {.ProgressWeight = 0.5, .Show = False})
'下载服务端文件
Loaders.Add(New LoaderDownload("下载服务端文件", New List(Of NetFile)) With {.ProgressWeight = 5})
'启动
Dim Loader As New LoaderCombo(Of String)("Minecraft " & Id & " 服务端下载", Loaders) With {.OnStateChanged = AddressOf LoaderStateChangedHintOnly}
Loader.Start(Id)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "开始 Minecraft 服务端下载失败", LogLevel.Feedback)
End Try
End Sub
Public Sub McDownloadMenuSave(sender As Object, e As RoutedEventArgs) Public Sub McDownloadMenuSave(sender As Object, e As RoutedEventArgs)
Dim Version As MyListItem Dim Version As MyListItem
If TypeOf sender Is MyListItem Then If TypeOf sender Is MyListItem Then
@@ -242,7 +290,41 @@ Public Module ModDownloadLib
Else Else
Version = sender.Parent.Parent Version = sender.Parent.Parent
End If End If
McDownloadClientCore(Version.Title, Version.Tag("url").ToString, NetPreDownloadBehaviour.HintWhileExists) Try
Dim Id = Version.Title
Dim JsonUrl = Version.Tag("url").ToString
Dim VersionFolder As String = SelectFolder()
If Not VersionFolder.Contains("\") Then Exit Sub
VersionFolder = VersionFolder & Id & "\"
'重复任务检查
For Each OngoingLoader In LoaderTaskbar.ToList()
If OngoingLoader.Name <> $"Minecraft {Id} 下载" Then Continue For
Hint("该版本正在下载中!", HintType.Critical)
Exit Sub
Next
Dim Loaders As New List(Of LoaderBase)
'下载版本 JSON 文件
Loaders.Add(New LoaderDownload("下载版本 JSON 文件", New List(Of NetFile) From {
New NetFile(DlSourceLauncherOrMetaGet(JsonUrl), VersionFolder & Id & ".json", New FileChecker(CanUseExistsFile:=False, IsJson:=True))
}) With {.ProgressWeight = 2})
'获取支持库文件地址
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("分析核心 JAR 文件下载地址",
Sub(Task) Task.Output = New List(Of NetFile) From {DlClientJarGet(New McVersion(VersionFolder), False)}
) With {.ProgressWeight = 0.5, .Show = False})
'下载支持库文件
Loaders.Add(New LoaderDownload("下载核心 JAR 文件", New List(Of NetFile)) With {.ProgressWeight = 5})
'启动
Dim Loader As New LoaderCombo(Of String)("Minecraft " & Id & " 下载", Loaders) With {.OnStateChanged = AddressOf LoaderStateChangedHintOnly}
Loader.Start(Id)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble()
Catch ex As Exception
Log(ex, "开始 Minecraft 下载失败", LogLevel.Feedback)
End Try
End Sub End Sub
''' <summary> ''' <summary>
''' 显示某 Minecraft 版本的更新日志。 ''' 显示某 Minecraft 版本的更新日志。
@@ -313,17 +395,17 @@ Public Module ModDownloadLib
Private Sub McDownloadOptiFineSave(DownloadInfo As DlOptiFineListEntry) Private Sub McDownloadOptiFineSave(DownloadInfo As DlOptiFineListEntry)
Try Try
Dim Id As String = DownloadInfo.NameVersion Dim Id As String = DownloadInfo.NameVersion
Dim Target As String = SelectAs("选择保存位置", DownloadInfo.NameFile, "OptiFine Jar (*.jar)|*.jar") Dim Target As String = SelectSaveFile("选择保存位置", DownloadInfo.NameFile, "OptiFine Jar (*.jar)|*.jar")
If Not Target.Contains("\") Then Exit Sub If Not Target.Contains("\") Then Exit Sub
'重复任务检查 '重复任务检查
For Each OngoingLoader In LoaderTaskbar For Each OngoingLoader In LoaderTaskbar.ToList()
If OngoingLoader.Name <> $"OptiFine {DownloadInfo.NameDisplay} 下载" Then Continue For If OngoingLoader.Name <> $"OptiFine {DownloadInfo.NameDisplay} 下载" Then Continue For
Hint("该版本正在下载中!", HintType.Critical) Hint("该版本正在下载中!", HintType.Critical)
Exit Sub Exit Sub
Next Next
Dim Loader As New LoaderCombo(Of DlOptiFineListEntry)("OptiFine " & DownloadInfo.NameDisplay & " 下载", McDownloadOptiFineSaveLoader(DownloadInfo, Target)) With {.OnStateChanged = AddressOf DownloadStateSave} Dim Loader As New LoaderCombo(Of DlOptiFineListEntry)("OptiFine " & DownloadInfo.NameDisplay & " 下载", McDownloadOptiFineSaveLoader(DownloadInfo, Target)) With {.OnStateChanged = AddressOf LoaderStateChangedHintOnly}
Loader.Start(DownloadInfo) Loader.Start(DownloadInfo)
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
@@ -358,10 +440,10 @@ Public Module ModDownloadLib
End SyncLock End SyncLock
'添加 Java Wrapper 作为主 Jar '添加 Java Wrapper 作为主 Jar
Dim Arguments As String Dim Arguments As String
If UseJavaWrapper Then If UseJavaWrapper AndAlso Not Setup.Get("LaunchAdvanceDisableJLW") Then
Arguments = $"-Doolloo.jlw.tmpdir=""{GetJavaWrapperDir()}"" -Duser.home=""{BaseMcFolderHome}"" -cp ""{Target}"" -jar ""{ExtractJavaWrapper()}"" optifine.Installer" Arguments = $"-Doolloo.jlw.tmpdir=""{PathPure.TrimEnd("\")}"" -Duser.home=""{BaseMcFolderHome.TrimEnd("\")}"" -cp ""{Target}"" -jar ""{ExtractJavaWrapper()}"" optifine.Installer"
Else Else
Arguments = $"-Duser.home=""{BaseMcFolderHome}"" -cp ""{Target}"" optifine.Installer" Arguments = $"-Duser.home=""{BaseMcFolderHome.TrimEnd("\")}"" -cp ""{Target}"" optifine.Installer"
End If End If
If Java.VersionCode >= 9 Then Arguments = "--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED " & Arguments If Java.VersionCode >= 9 Then Arguments = "--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED " & Arguments
'开始启动 '开始启动
@@ -373,7 +455,7 @@ Public Module ModDownloadLib
.CreateNoWindow = True, .CreateNoWindow = True,
.RedirectStandardError = True, .RedirectStandardError = True,
.RedirectStandardOutput = True, .RedirectStandardOutput = True,
.WorkingDirectory = BaseMcFolderHome .WorkingDirectory = ShortenPath(BaseMcFolderHome)
} }
If Info.EnvironmentVariables.ContainsKey("appdata") Then If Info.EnvironmentVariables.ContainsKey("appdata") Then
Info.EnvironmentVariables("appdata") = BaseMcFolderHome Info.EnvironmentVariables("appdata") = BaseMcFolderHome
@@ -463,76 +545,76 @@ Public Module ModDownloadLib
Dim VersionFolder As String = McFolder & "versions\" & Id & "\" Dim VersionFolder As String = McFolder & "versions\" & Id & "\"
Dim IsNewVersion As Boolean = DownloadInfo.Inherit.Contains("w") OrElse Val(DownloadInfo.Inherit.Split(".")(1)) >= 14 Dim IsNewVersion As Boolean = DownloadInfo.Inherit.Contains("w") OrElse Val(DownloadInfo.Inherit.Split(".")(1)) >= 14
Dim Target As String = If(IsNewVersion, Dim Target As String = If(IsNewVersion,
PathTemp & "Cache\Code\" & DownloadInfo.NameVersion & "_" & GetUuid(), $"{RequestTaskTempFolder()}OptiFine.jar",
McFolder & "libraries\optifine\OptiFine\" & DownloadInfo.NameFile.Replace("OptiFine_", "").Replace(".jar", "").Replace("preview_", "") & "\" & DownloadInfo.NameFile.Replace("OptiFine_", "OptiFine-").Replace("preview_", "")) $"{McFolder}libraries\optifine\OptiFine\{DownloadInfo.NameFile.Replace("OptiFine_", "").Replace(".jar", "").Replace("preview_", "")}\{DownloadInfo.NameFile.Replace("OptiFine_", "OptiFine-").Replace("preview_", "")}")
Dim Loaders As New List(Of LoaderBase) Dim Loaders As New List(Of LoaderBase)
'获取下载地址 '获取下载地址
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("获取 OptiFine 主文件下载地址", Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("获取 OptiFine 主文件下载地址",
Sub(Task As LoaderTask(Of String, List(Of NetFile))) Sub(Task As LoaderTask(Of String, List(Of NetFile)))
'启动依赖版本的下载 '启动依赖版本的下载
If ClientDownloadLoader Is Nothing Then If ClientDownloadLoader Is Nothing Then
If IsCustomFolder Then Throw New Exception("如果没有指定原版下载器,则不能指定 MC 安装文件夹") If IsCustomFolder Then Throw New Exception("如果没有指定原版下载器,则不能指定 MC 安装文件夹")
ClientDownloadLoader = McDownloadClient(NetPreDownloadBehaviour.ExitWhileExistsOrDownloading, DownloadInfo.Inherit) ClientDownloadLoader = McDownloadClient(NetPreDownloadBehaviour.ExitWhileExistsOrDownloading, DownloadInfo.Inherit)
End If End If
Task.Progress = 0.1 Task.Progress = 0.1
Dim Sources As New List(Of String) Dim Sources As New List(Of String)
'BMCLAPI 源 'BMCLAPI 源
If DownloadInfo.IsPreview Then Dim BmclapiInherit As String = DownloadInfo.Inherit
Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & DownloadInfo.Inherit & "/HD_U_" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "").Replace(" ", "/")) If BmclapiInherit = "1.8" OrElse BmclapiInherit = "1.9" Then BmclapiInherit &= ".0" '#4281
Else If DownloadInfo.IsPreview Then
Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & DownloadInfo.Inherit & "/HD_U/" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "")) Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & BmclapiInherit & "/HD_U_" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "").Replace(" ", "/"))
End If Else
'官方源 Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & BmclapiInherit & "/HD_U/" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", ""))
Dim PageData As String End If
Try '官方源
PageData = NetGetCodeByClient("https://optifine.net/adloadx?f=" & DownloadInfo.NameFile, New UTF8Encoding(False), 15000, "text/html", True) Dim PageData As String
Task.Progress = 0.8 Try
Sources.Add("https://optifine.net/" & RegexSearch(PageData, "downloadx\?f=[^""']+")(0)) PageData = NetGetCodeByClient("https://optifine.net/adloadx?f=" & DownloadInfo.NameFile, New UTF8Encoding(False), 15000, "text/html", True)
Log("[Download] OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址:" & Sources(0)) Task.Progress = 0.8
Catch ex As Exception Sources.Add("https://optifine.net/" & RegexSearch(PageData, "downloadx\?f=[^""']+")(0))
Log(ex, "获取 OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址失败") Log("[Download] OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址:" & Sources.Last)
End Try Catch ex As Exception
'OptiFine 中文镜像源 Log(ex, "获取 OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址失败")
Sources.Add("https://optifine.cn/download/" & DownloadInfo.NameFile) End Try
'构造文件请求 '构造文件请求
Task.Output = New List(Of NetFile) From {New NetFile(Sources.ToArray, Target, New FileChecker(MinSize:=300 * 1024))} Task.Output = New List(Of NetFile) From {New NetFile(Sources.ToArray, Target, New FileChecker(MinSize:=300 * 1024))}
End Sub) With {.ProgressWeight = 8}) End Sub) With {.ProgressWeight = 8})
Loaders.Add(New LoaderDownload("下载 OptiFine 主文件", New List(Of NetFile)) With {.ProgressWeight = 8}) Loaders.Add(New LoaderDownload("下载 OptiFine 主文件", New List(Of NetFile)) With {.ProgressWeight = 8})
Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("等待原版下载", Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("等待原版下载",
Sub(Task As LoaderTask(Of List(Of NetFile), Boolean)) Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
'等待原版文件下载完成 '等待原版文件下载完成
If ClientDownloadLoader Is Nothing Then Exit Sub If ClientDownloadLoader Is Nothing Then Exit Sub
Dim TargetLoaders As List(Of LoaderBase) = Dim TargetLoaders As List(Of LoaderBase) =
ClientDownloadLoader.GetLoaderList.Where(Function(l) l.Name = McDownloadClientLibName OrElse l.Name = McDownloadClientJsonName). ClientDownloadLoader.GetLoaderList.Where(Function(l) l.Name = McDownloadClientLibName OrElse l.Name = McDownloadClientJsonName).
Where(Function(l) l.State <> LoadState.Finished).ToList Where(Function(l) l.State <> LoadState.Finished).ToList
If TargetLoaders.Any Then Log("[Download] OptiFine 安装正在等待原版文件下载完成") If TargetLoaders.Any Then Log("[Download] OptiFine 安装正在等待原版文件下载完成")
Do While TargetLoaders.Any AndAlso Not Task.IsAborted Do While TargetLoaders.Any AndAlso Not Task.IsAborted
TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList
Thread.Sleep(50) Thread.Sleep(50)
Loop Loop
If Task.IsAborted Then Exit Sub If Task.IsAborted Then Exit Sub
'拷贝原版文件 '拷贝原版文件
If Not IsCustomFolder Then Exit Sub If Not IsCustomFolder Then Exit Sub
SyncLock VanillaSyncLock SyncLock VanillaSyncLock
Dim ClientName As String = GetFolderNameFromPath(ClientFolder) Dim ClientName As String = GetFolderNameFromPath(ClientFolder)
Directory.CreateDirectory(McFolder & "versions\" & DownloadInfo.Inherit) Directory.CreateDirectory(McFolder & "versions\" & DownloadInfo.Inherit)
If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json") Then If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json") Then
CopyFile($"{ClientFolder}{ClientName}.json", $"{McFolder}versions\{DownloadInfo.Inherit}\{DownloadInfo.Inherit}.json") CopyFile($"{ClientFolder}{ClientName}.json", $"{McFolder}versions\{DownloadInfo.Inherit}\{DownloadInfo.Inherit}.json")
End If End If
If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar") Then If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar") Then
CopyFile($"{ClientFolder}{ClientName}.jar", $"{McFolder}versions\{DownloadInfo.Inherit}\{DownloadInfo.Inherit}.jar") CopyFile($"{ClientFolder}{ClientName}.jar", $"{McFolder}versions\{DownloadInfo.Inherit}\{DownloadInfo.Inherit}.jar")
End If End If
End SyncLock End SyncLock
End Sub) With {.ProgressWeight = 0.1, .Show = False}) End Sub) With {.ProgressWeight = 0.1, .Show = False})
'安装(新旧方式均需要原版 Jar 和 Json) '安装(新旧方式均需要原版 Jar 和 Json)
If IsNewVersion Then If IsNewVersion Then
Log("[Download] 检测为新版 OptiFine:" & DownloadInfo.Inherit) Log("[Download] 检测为新版 OptiFine:" & DownloadInfo.Inherit)
Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("安装 OptiFine(方式 A)", Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("安装 OptiFine(方式 A)",
Sub(Task As LoaderTask(Of List(Of NetFile), Boolean)) Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
Dim BaseMcFolderHome As String = PathTemp & "InstallOptiFine" & RandomInteger(0, 100000) Dim BaseMcFolderHome As String = RequestTaskTempFolder()
Dim BaseMcFolder As String = BaseMcFolderHome & "\.minecraft\" Dim BaseMcFolder As String = BaseMcFolderHome & ".minecraft\"
Try Try
'准备安装环境 '准备安装环境
If Directory.Exists(BaseMcFolder & "versions\" & DownloadInfo.Inherit) Then If Directory.Exists(BaseMcFolder & "versions\" & DownloadInfo.Inherit) Then
@@ -641,10 +723,12 @@ Retry:
Sub(Task As LoaderTask(Of DlOptiFineListEntry, List(Of NetFile))) Sub(Task As LoaderTask(Of DlOptiFineListEntry, List(Of NetFile)))
Dim Sources As New List(Of String) Dim Sources As New List(Of String)
'BMCLAPI 源 'BMCLAPI 源
Dim BmclapiInherit As String = DownloadInfo.Inherit
If BmclapiInherit = "1.8" OrElse BmclapiInherit = "1.9" Then BmclapiInherit &= ".0" '#4281
If DownloadInfo.IsPreview Then If DownloadInfo.IsPreview Then
Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & DownloadInfo.Inherit & "/HD_U_" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "").Replace(" ", "/")) Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & BmclapiInherit & "/HD_U_" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "").Replace(" ", "/"))
Else Else
Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & DownloadInfo.Inherit & "/HD_U/" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", "")) Sources.Add("https://bmclapi2.bangbang93.com/optifine/" & BmclapiInherit & "/HD_U/" & DownloadInfo.NameDisplay.Replace(DownloadInfo.Inherit & " ", ""))
End If End If
'官方源 '官方源
Dim PageData As String Dim PageData As String
@@ -652,7 +736,7 @@ Retry:
PageData = NetGetCodeByClient("https://optifine.net/adloadx?f=" & DownloadInfo.NameFile, New UTF8Encoding(False), 15000, "text/html", True) PageData = NetGetCodeByClient("https://optifine.net/adloadx?f=" & DownloadInfo.NameFile, New UTF8Encoding(False), 15000, "text/html", True)
Task.Progress = 0.8 Task.Progress = 0.8
Sources.Add("https://optifine.net/" & RegexSearch(PageData, "downloadx\?f=[^""']+")(0)) Sources.Add("https://optifine.net/" & RegexSearch(PageData, "downloadx\?f=[^""']+")(0))
Log("[Download] OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址:" & Sources(0)) Log("[Download] OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址:" & Sources.Last)
Catch ex As Exception Catch ex As Exception
Log(ex, "获取 OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址失败") Log(ex, "获取 OptiFine " & DownloadInfo.NameDisplay & " 官方下载地址失败")
End Try End Try
@@ -675,7 +759,7 @@ Retry:
.Title = Entry.NameDisplay, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .Title = Entry.NameDisplay, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry,
.Info = If(Entry.IsPreview, "测试版", "正式版") & .Info = If(Entry.IsPreview, "测试版", "正式版") &
If(Entry.ReleaseTime = "", "", ",发布于 " & Entry.ReleaseTime) & If(Entry.ReleaseTime = "", "", ",发布于 " & Entry.ReleaseTime) &
If(Entry.RequiredForgeVersion Is Nothing, ",不兼容 Forge", If(Entry.RequiredForgeVersion = "", "", ",推荐 Forge 版本:" & Entry.RequiredForgeVersion)), If(Entry.RequiredForgeVersion Is Nothing, ",不兼容 Forge", If(Entry.RequiredForgeVersion = "", "", ",兼容 Forge " & Entry.RequiredForgeVersion)),
.Logo = PathImage & "Blocks/GrassPath.png" .Logo = PathImage & "Blocks/GrassPath.png"
} }
AddHandler NewItem.Click, OnClick AddHandler NewItem.Click, OnClick
@@ -744,7 +828,7 @@ Retry:
Dim VersionFolder As String = PathMcFolder & "versions\" & VersionName & "\" Dim VersionFolder As String = PathMcFolder & "versions\" & VersionName & "\"
'重复任务检查 '重复任务检查
For Each OngoingLoader In LoaderTaskbar For Each OngoingLoader In LoaderTaskbar.ToList()
If OngoingLoader.Name <> $"LiteLoader {Id} 下载" Then Continue For If OngoingLoader.Name <> $"LiteLoader {Id} 下载" Then Continue For
Hint("该版本正在下载中!", HintType.Critical) Hint("该版本正在下载中!", HintType.Critical)
Exit Sub Exit Sub
@@ -774,11 +858,11 @@ Retry:
Private Sub McDownloadLiteLoaderSave(DownloadInfo As DlLiteLoaderListEntry) Private Sub McDownloadLiteLoaderSave(DownloadInfo As DlLiteLoaderListEntry)
Try Try
Dim Id As String = DownloadInfo.Inherit Dim Id As String = DownloadInfo.Inherit
Dim Target As String = SelectAs("选择保存位置", DownloadInfo.FileName.Replace("-SNAPSHOT", ""), "LiteLoader 安装器 (*.jar)|*.jar") Dim Target As String = SelectSaveFile("选择保存位置", DownloadInfo.FileName.Replace("-SNAPSHOT", ""), "LiteLoader 安装器 (*.jar)|*.jar")
If Not Target.Contains("\") Then Exit Sub If Not Target.Contains("\") Then Exit Sub
'重复任务检查 '重复任务检查
For Each OngoingLoader In LoaderTaskbar For Each OngoingLoader In LoaderTaskbar.ToList()
If OngoingLoader.Name <> $"LiteLoader {Id} 下载" Then Continue For If OngoingLoader.Name <> $"LiteLoader {Id} 下载" Then Continue For
Hint("该版本正在下载中!", HintType.Critical) Hint("该版本正在下载中!", HintType.Critical)
Exit Sub Exit Sub
@@ -810,7 +894,7 @@ Retry:
End If End If
Loaders.Add(New LoaderDownload("下载主文件", New List(Of NetFile) From {New NetFile(Address.ToArray, Target, New FileChecker(MinSize:=1024 * 1024))}) With {.ProgressWeight = 15}) Loaders.Add(New LoaderDownload("下载主文件", New List(Of NetFile) From {New NetFile(Address.ToArray, Target, New FileChecker(MinSize:=1024 * 1024))}) With {.ProgressWeight = 15})
'启动 '启动
Dim Loader As New LoaderCombo(Of DlLiteLoaderListEntry)("LiteLoader " & Id & " 安装器下载", Loaders) With {.OnStateChanged = AddressOf DownloadStateSave} Dim Loader As New LoaderCombo(Of DlLiteLoaderListEntry)("LiteLoader " & Id & " 安装器下载", Loaders) With {.OnStateChanged = AddressOf LoaderStateChangedHintOnly}
Loader.Start(DownloadInfo) Loader.Start(DownloadInfo)
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
@@ -954,13 +1038,13 @@ Retry:
Public Sub McDownloadForgelikeSave(Info As DlForgelikeEntry) Public Sub McDownloadForgelikeSave(Info As DlForgelikeEntry)
Try Try
Dim Target As String = SelectAs("选择保存位置", $"{Info.LoaderName}-{Info.Inherit}-{Info.VersionName}.{Info.FileExtension}", Dim Target As String = SelectSaveFile("选择保存位置", $"{Info.LoaderName}-{Info.Inherit}-{Info.VersionName}.{Info.FileExtension}",
$"{Info.LoaderName} 安装器 (*.{Info.FileExtension})|*.{Info.FileExtension}") $"{Info.LoaderName} 安装器 (*.{Info.FileExtension})|*.{Info.FileExtension}")
Dim DisplayName As String = $"{Info.LoaderName} {Info.Inherit} - {Info.VersionName}" Dim DisplayName As String = $"{Info.LoaderName} {Info.Inherit} - {Info.VersionName}"
If Not Target.Contains("\") Then Exit Sub If Not Target.Contains("\") Then Exit Sub
'重复任务检查 '重复任务检查
For Each OngoingLoader In LoaderTaskbar For Each OngoingLoader In LoaderTaskbar.ToList()
If OngoingLoader.Name <> $"{DisplayName} 下载" Then Continue For If OngoingLoader.Name <> $"{DisplayName} 下载" Then Continue For
Hint("该版本正在下载中!", HintType.Critical) Hint("该版本正在下载中!", HintType.Critical)
Exit Sub Exit Sub
@@ -989,7 +1073,7 @@ Retry:
Loaders.Add(New LoaderDownload("下载主文件", Files) With {.ProgressWeight = 6}) Loaders.Add(New LoaderDownload("下载主文件", Files) With {.ProgressWeight = 6})
'启动 '启动
Dim Loader = New LoaderCombo(Of DlForgelikeEntry)(DisplayName & " 下载", Loaders) With {.OnStateChanged = AddressOf DownloadStateSave} Dim Loader = New LoaderCombo(Of DlForgelikeEntry)(DisplayName & " 下载", Loaders) With {.OnStateChanged = AddressOf LoaderStateChangedHintOnly}
Loader.Start(Info) Loader.Start(Info)
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
@@ -1025,8 +1109,8 @@ Retry:
End SyncLock End SyncLock
'添加 Java Wrapper 作为主 Jar '添加 Java Wrapper 作为主 Jar
Dim Arguments As String Dim Arguments As String
If UseJavaWrapper Then If UseJavaWrapper AndAlso Not Setup.Get("LaunchAdvanceDisableJLW") Then
Arguments = $"-Doolloo.jlw.tmpdir=""{GetJavaWrapperDir()}"" -cp ""{PathTemp}Cache\forge_installer.jar;{Target}"" -jar ""{ExtractJavaWrapper()}"" com.bangbang93.ForgeInstaller ""{McFolder}" Arguments = $"-Doolloo.jlw.tmpdir=""{PathPure.TrimEnd("\")}"" -cp ""{PathTemp}Cache\forge_installer.jar;{Target}"" -jar ""{ExtractJavaWrapper()}"" com.bangbang93.ForgeInstaller ""{McFolder}"
Else Else
Arguments = $"-cp ""{PathTemp}Cache\forge_installer.jar;{Target}"" com.bangbang93.ForgeInstaller ""{McFolder}" Arguments = $"-cp ""{PathTemp}Cache\forge_installer.jar;{Target}"" com.bangbang93.ForgeInstaller ""{McFolder}"
End If End If
@@ -1175,12 +1259,12 @@ Retry:
End If End If
If Not IsNeoForge AndAlso LoaderVersion.StartsWithF("1.") AndAlso LoaderVersion.Contains("-") Then If Not IsNeoForge AndAlso LoaderVersion.StartsWithF("1.") AndAlso LoaderVersion.Contains("-") Then
'类似 1.19.3-41.2.8 格式,优先使用 Version 中要求的版本而非 Inherit(例如 1.19.3 却使用了 1.19 的 Forge) '类似 1.19.3-41.2.8 格式,优先使用 Version 中要求的版本而非 Inherit(例如 1.19.3 却使用了 1.19 的 Forge)
Inherit = LoaderVersion.Before("-") Inherit = LoaderVersion.BeforeFirst("-")
LoaderVersion = LoaderVersion.After("-") LoaderVersion = LoaderVersion.AfterLast("-")
End If End If
Dim LoaderName As String = If(IsNeoForge, "NeoForge", "Forge") Dim LoaderName As String = If(IsNeoForge, "NeoForge", "Forge")
Dim IsCustomFolder As Boolean = McFolder <> PathMcFolder Dim IsCustomFolder As Boolean = McFolder <> PathMcFolder
Dim InstallerAddress As String = $"{PathTemp}Cache\Code\{LoaderName}Install-{LoaderVersion}_{RandomInteger(0, 100000)}" Dim InstallerAddress As String = RequestTaskTempFolder() & "forge_installer.jar"
Dim VersionFolder As String = $"{McFolder}versions\{TargetVersion}\" Dim VersionFolder As String = $"{McFolder}versions\{TargetVersion}\"
Dim DisplayName As String = $"{LoaderName} {Inherit} - {LoaderVersion}" Dim DisplayName As String = $"{LoaderName} {Inherit} - {LoaderVersion}"
Dim Loaders As New List(Of LoaderBase) Dim Loaders As New List(Of LoaderBase)
@@ -1236,7 +1320,7 @@ Retry:
Loaders.Add(New LoaderDownload($"下载 {LoaderName} 主文件", New List(Of NetFile)) With {.ProgressWeight = 9}) Loaders.Add(New LoaderDownload($"下载 {LoaderName} 主文件", New List(Of NetFile)) With {.ProgressWeight = 9})
'安装(仅在新版安装时需要原版 Jar) '安装(仅在新版安装时需要原版 Jar)
If IsNeoForge OrElse LoaderVersion.Before(".") >= 20 Then If IsNeoForge OrElse LoaderVersion.BeforeFirst(".") >= 20 Then
Log($"[Download] 检测为{If(IsNeoForge, " Neo", "新版 ")}Forge:" & LoaderVersion) Log($"[Download] 检测为{If(IsNeoForge, " Neo", "新版 ")}Forge:" & LoaderVersion)
Dim Libs As List(Of McLibToken) = Nothing Dim Libs As List(Of McLibToken) = Nothing
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))($"分析 {LoaderName} 支持库文件", Loaders.Add(New LoaderTask(Of String, List(Of NetFile))($"分析 {LoaderName} 支持库文件",
@@ -1256,9 +1340,9 @@ Retry:
If Json("data") IsNot Nothing AndAlso Json("data")("MOJMAPS") IsNot Nothing Then If Json("data") IsNot Nothing AndAlso Json("data")("MOJMAPS") IsNot Nothing Then
'下载原版 Json 文件 '下载原版 Json 文件
Task.Progress = 0.4 Task.Progress = 0.4
Dim RawJson As JObject = GetJson(NetGetCodeByDownload(DlSourceLauncherOrMetaGet(DlClientListGet(Inherit)), IsJson:=True)) Dim RawJson As JObject = GetJson(NetGetCodeByLoader(DlSourceLauncherOrMetaGet(DlClientListGet(Inherit)), IsJson:=True))
'[net.minecraft:client:1.17.1-20210706.113038:mappings@txt] 或 @tsrg] '[net.minecraft:client:1.17.1-20210706.113038:mappings@txt] 或 @tsrg]
Dim OriginalName As String = Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Before("@") Dim OriginalName As String = Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).BeforeFirst("@")
Dim Address = McLibGet(OriginalName).Replace(".jar", "-mappings." & Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(1)) Dim Address = McLibGet(OriginalName).Replace(".jar", "-mappings." & Json("data")("MOJMAPS")("client").ToString.Trim("[]".ToCharArray()).Split("@")(1))
Dim ClientMappings As JToken = RawJson("downloads")("client_mappings") Dim ClientMappings As JToken = RawJson("downloads")("client_mappings")
Libs.Add(New McLibToken With { Libs.Add(New McLibToken With {
@@ -1270,7 +1354,7 @@ Retry:
'去除其中的原始 Forgelike 项 '去除其中的原始 Forgelike 项
For i = 0 To Libs.Count - 1 For i = 0 To Libs.Count - 1
If Libs(i).LocalPath.EndsWithF($"{LoaderName.ToLower}-{Inherit}-{LoaderVersion}.jar") OrElse If Libs(i).LocalPath.EndsWithF($"{LoaderName.ToLower}-{Inherit}-{LoaderVersion}.jar") OrElse
Libs(i).LocalPath.EndsWithF($"{LoaderName.ToLower}-{Inherit}-{LoaderVersion}-client.jar") Then Libs(i).LocalPath.EndsWithF($"{LoaderName.ToLower}-{Inherit}-{LoaderVersion}-client.jar") Then
Log($"[Download] 已从待下载 {LoaderName} 支持库中移除:" & Libs(i).LocalPath, LogLevel.Debug) Log($"[Download] 已从待下载 {LoaderName} 支持库中移除:" & Libs(i).LocalPath, LogLevel.Debug)
Libs.RemoveAt(i) Libs.RemoveAt(i)
Exit For Exit For
@@ -1381,8 +1465,6 @@ Retry:
'没有新增文件夹 '没有新增文件夹
Log("[Download] 未找到新增的版本文件夹") Log("[Download] 未找到新增的版本文件夹")
End If End If
'新建 mods 文件夹
Directory.CreateDirectory(New McVersion(VersionFolder).GetPathIndie(True) & "mods\")
Catch ex As Exception Catch ex As Exception
Throw New Exception($"安装新 {LoaderName} 版本失败", ex) Throw New Exception($"安装新 {LoaderName} 版本失败", ex)
Finally Finally
@@ -1398,54 +1480,52 @@ Retry:
Else Else
Log("[Download] 检测为非新版 Forge:" & LoaderVersion) Log("[Download] 检测为非新版 Forge:" & LoaderVersion)
Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)($"安装 {LoaderName}(方式 B)", Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)($"安装 {LoaderName}(方式 B)",
Sub(Task As LoaderTask(Of List(Of NetFile), Boolean)) Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
Dim Installer As ZipArchive = Nothing Dim Installer As ZipArchive = Nothing
Try Try
'解压并获取信息 '解压并获取信息
Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open)) Installer = New ZipArchive(New FileStream(InstallerAddress, FileMode.Open))
Task.Progress = 0.2 Task.Progress = 0.2
Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open)) Dim Json As JObject = GetJson(ReadFile(Installer.GetEntry("install_profile.json").Open))
Task.Progress = 0.4 Task.Progress = 0.4
'新建版本文件夹 '新建版本文件夹
Directory.CreateDirectory(VersionFolder) Directory.CreateDirectory(VersionFolder)
Task.Progress = 0.5 Task.Progress = 0.5
If Json("install") Is Nothing Then If Json("install") Is Nothing Then
'中版:Legacy 方式 1 '中版:Legacy 方式 1
Log("[Download] 开始进行 Forge 安装,Legacy 方式 1:" & InstallerAddress) Log("[Download] 开始进行 Forge 安装,Legacy 方式 1:" & InstallerAddress)
'建立 Json 文件 '建立 Json 文件
Dim JsonVersion As JObject = GetJson(ReadFile(Installer.GetEntry(Json("json").ToString.TrimStart("/")).Open)) Dim JsonVersion As JObject = GetJson(ReadFile(Installer.GetEntry(Json("json").ToString.TrimStart("/")).Open))
JsonVersion("id") = TargetVersion JsonVersion("id") = TargetVersion
WriteFile(VersionFolder & TargetVersion & ".json", JsonVersion.ToString) WriteFile(VersionFolder & TargetVersion & ".json", JsonVersion.ToString)
Task.Progress = 0.6 Task.Progress = 0.6
'解压支持库文件 '解压支持库文件
Installer.Dispose() Installer.Dispose()
ExtractFile(InstallerAddress, InstallerAddress & "_unrar\") ExtractFile(InstallerAddress, InstallerAddress & "_unrar\")
CopyDirectory(InstallerAddress & "_unrar\maven\", McFolder & "libraries\") CopyDirectory(InstallerAddress & "_unrar\maven\", McFolder & "libraries\")
DeleteDirectory(InstallerAddress & "_unrar\") DeleteDirectory(InstallerAddress & "_unrar\")
Else Else
'旧版:Legacy 方式 2 '旧版:Legacy 方式 2
Log("[Download] 开始进行 Forge 安装,Legacy 方式 2:" & InstallerAddress) Log("[Download] 开始进行 Forge 安装,Legacy 方式 2:" & InstallerAddress)
'解压 Jar 文件 '解压 Jar 文件
Dim JarAddress As String = McLibGet(Json("install")("path"), CustomMcFolder:=McFolder) Dim JarAddress As String = McLibGet(Json("install")("path"), CustomMcFolder:=McFolder)
If File.Exists(JarAddress) Then File.Delete(JarAddress) If File.Exists(JarAddress) Then File.Delete(JarAddress)
WriteFile(JarAddress, Installer.GetEntry(Json("install")("filePath")).Open) WriteFile(JarAddress, Installer.GetEntry(Json("install")("filePath")).Open)
Task.Progress = 0.9 Task.Progress = 0.9
'建立 Json 文件 '建立 Json 文件
Json("versionInfo")("id") = TargetVersion Json("versionInfo")("id") = TargetVersion
If Json("versionInfo")("inheritsFrom") Is Nothing Then CType(Json("versionInfo"), JObject).Add("inheritsFrom", Inherit) If Json("versionInfo")("inheritsFrom") Is Nothing Then CType(Json("versionInfo"), JObject).Add("inheritsFrom", Inherit)
WriteFile(VersionFolder & TargetVersion & ".json", Json("versionInfo").ToString) WriteFile(VersionFolder & TargetVersion & ".json", Json("versionInfo").ToString)
End If End If
'新建 mods 文件夹 Catch ex As Exception
Directory.CreateDirectory(New McVersion(VersionFolder).GetPathIndie(True) & "mods\") Throw New Exception("非新版方式安装 Forge 失败", ex)
Catch ex As Exception Finally
Throw New Exception("非新版方式安装 Forge 失败", ex) Try
Finally '清理文件
Try If Installer IsNot Nothing Then Installer.Dispose()
'清理文件 If File.Exists(InstallerAddress) Then File.Delete(InstallerAddress)
If Installer IsNot Nothing Then Installer.Dispose() If Directory.Exists(InstallerAddress & "_unrar\") Then DeleteDirectory(InstallerAddress & "_unrar\")
If File.Exists(InstallerAddress) Then File.Delete(InstallerAddress) Catch ex As Exception
If Directory.Exists(InstallerAddress & "_unrar\") Then DeleteDirectory(InstallerAddress & "_unrar\")
Catch ex As Exception
Log(ex, "非新版方式安装 Forge 清理文件时出错") Log(ex, "非新版方式安装 Forge 清理文件时出错")
End Try End Try
End Try End Try
@@ -1460,6 +1540,8 @@ Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
#Region "Forge 下载菜单" #Region "Forge 下载菜单"
Public Sub ForgeDownloadListItemPreload(Stack As StackPanel, Entries As List(Of DlForgeVersionEntry), OnClick As MyListItem.ClickEventHandler, IsSaveOnly As Boolean) Public Sub ForgeDownloadListItemPreload(Stack As StackPanel, Entries As List(Of DlForgeVersionEntry), OnClick As MyListItem.ClickEventHandler, IsSaveOnly As Boolean)
'如果只有一个版本,则不特别列出
If Entries.Count = 1 Then Return
'获取推荐版本与最新版本 '获取推荐版本与最新版本
Dim FreshVersion As DlForgeVersionEntry = Nothing Dim FreshVersion As DlForgeVersionEntry = Nothing
If Entries.Any Then If Entries.Any Then
@@ -1562,7 +1644,7 @@ Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
RunInNewThread(Sub() RunInNewThread(Sub()
Try Try
Log("[Download] 刷新 Forge 推荐版本缓存开始") Log("[Download] 刷新 Forge 推荐版本缓存开始")
Dim Result As String = NetGetCodeByDownload("https://bmclapi2.bangbang93.com/forge/promos") Dim Result As String = NetGetCodeByLoader("https://bmclapi2.bangbang93.com/forge/promos")
If Result.Length < 1000 Then Throw New Exception("获取的结果过短(" & Result & ")") If Result.Length < 1000 Then Throw New Exception("获取的结果过短(" & Result & ")")
Dim ResultJson As JContainer = GetJson(Result) Dim ResultJson As JContainer = GetJson(Result)
'获取所有推荐版本列表 '获取所有推荐版本列表
@@ -1611,6 +1693,8 @@ Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
#Region "NeoForge 下载菜单" #Region "NeoForge 下载菜单"
Public Sub NeoForgeDownloadListItemPreload(Stack As StackPanel, Entries As List(Of DlNeoForgeListEntry), OnClick As MyListItem.ClickEventHandler, IsSaveOnly As Boolean) Public Sub NeoForgeDownloadListItemPreload(Stack As StackPanel, Entries As List(Of DlNeoForgeListEntry), OnClick As MyListItem.ClickEventHandler, IsSaveOnly As Boolean)
'如果只有一个版本,则不特别列出
If Entries.Count = 1 Then Return
'获取最新稳定版和测试版 '获取最新稳定版和测试版
Dim FreshStableVersion As DlNeoForgeListEntry = Nothing Dim FreshStableVersion As DlNeoForgeListEntry = Nothing
Dim FreshBetaVersion As DlNeoForgeListEntry = Nothing Dim FreshBetaVersion As DlNeoForgeListEntry = Nothing
@@ -1710,11 +1794,11 @@ Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
Dim Url As String = DownloadInfo("url").ToString Dim Url As String = DownloadInfo("url").ToString
Dim FileName As String = GetFileNameFromPath(Url) Dim FileName As String = GetFileNameFromPath(Url)
Dim Version As String = GetFileNameFromPath(DownloadInfo("version").ToString) Dim Version As String = GetFileNameFromPath(DownloadInfo("version").ToString)
Dim Target As String = SelectAs("选择保存位置", FileName, "Fabric 安装器 (*.jar)|*.jar") Dim Target As String = SelectSaveFile("选择保存位置", FileName, "Fabric 安装器 (*.jar)|*.jar")
If Not Target.Contains("\") Then Exit Sub If Not Target.Contains("\") Then Exit Sub
'重复任务检查 '重复任务检查
For Each OngoingLoader In LoaderTaskbar For Each OngoingLoader In LoaderTaskbar.ToList()
If OngoingLoader.Name <> $"Fabric {Version} 安装器下载" Then Continue For If OngoingLoader.Name <> $"Fabric {Version} 安装器下载" Then Continue For
Hint("该版本正在下载中!", HintType.Critical) Hint("该版本正在下载中!", HintType.Critical)
Exit Sub Exit Sub
@@ -1728,7 +1812,7 @@ Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
Address.Add(Url) Address.Add(Url)
Loaders.Add(New LoaderDownload("下载主文件", New List(Of NetFile) From {New NetFile(Address.ToArray, Target, New FileChecker(MinSize:=1024 * 64))}) With {.ProgressWeight = 15}) Loaders.Add(New LoaderDownload("下载主文件", New List(Of NetFile) From {New NetFile(Address.ToArray, Target, New FileChecker(MinSize:=1024 * 64))}) With {.ProgressWeight = 15})
'启动 '启动
Dim Loader As New LoaderCombo(Of JObject)("Fabric " & Version & " 安装器下载", Loaders) With {.OnStateChanged = AddressOf DownloadStateSave} Dim Loader As New LoaderCombo(Of JObject)("Fabric " & Version & " 安装器下载", Loaders) With {.OnStateChanged = AddressOf LoaderStateChangedHintOnly}
Loader.Start(DownloadInfo) Loader.Start(DownloadInfo)
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
@@ -1765,8 +1849,6 @@ Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
"https://bmclapi2.bangbang93.com/fabric-meta/v2/versions/loader/" & MinecraftName & "/" & FabricVersion & "/profile/json", "https://bmclapi2.bangbang93.com/fabric-meta/v2/versions/loader/" & MinecraftName & "/" & FabricVersion & "/profile/json",
"https://meta.fabricmc.net/v2/versions/loader/" & MinecraftName & "/" & FabricVersion & "/profile/json" "https://meta.fabricmc.net/v2/versions/loader/" & MinecraftName & "/" & FabricVersion & "/profile/json"
}, VersionFolder & Id & ".json", New FileChecker(IsJson:=True))} }, VersionFolder & Id & ".json", New FileChecker(IsJson:=True))}
'新建 mods 文件夹
Directory.CreateDirectory(New McVersion(VersionFolder).GetPathIndie(True) & "mods\")
End Sub) With {.ProgressWeight = 0.5}) End Sub) With {.ProgressWeight = 0.5})
Loaders.Add(New LoaderDownload("下载 Fabric 主文件", New List(Of NetFile)) With {.ProgressWeight = 2.5}) Loaders.Add(New LoaderDownload("下载 Fabric 主文件", New List(Of NetFile)) With {.ProgressWeight = 2.5})
@@ -1798,7 +1880,7 @@ Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
Public Function FabricApiDownloadListItem(Entry As CompFile, OnClick As MyListItem.ClickEventHandler) As MyListItem Public Function FabricApiDownloadListItem(Entry As CompFile, OnClick As MyListItem.ClickEventHandler) As MyListItem
'建立控件 '建立控件
Dim NewItem As New MyListItem With { Dim NewItem As New MyListItem With {
.Title = Entry.DisplayName.Split("]")(1).Replace("Fabric API ", "").Replace(" build ", ".").Before("+").Trim, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry, .Title = Entry.DisplayName.Split("]")(1).Replace("Fabric API ", "").Replace(" build ", ".").BeforeFirst("+").Trim, .SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Entry,
.Info = Entry.StatusDescription & ",发布于 " & Entry.ReleaseDate.ToString("yyyy'/'MM'/'dd HH':'mm"), .Info = Entry.StatusDescription & ",发布于 " & Entry.ReleaseDate.ToString("yyyy'/'MM'/'dd HH':'mm"),
.Logo = PathImage & "Blocks/Fabric.png" .Logo = PathImage & "Blocks/Fabric.png"
} }
@@ -1897,6 +1979,20 @@ Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
End Class End Class
''' <summary>
''' 在加载器状态改变后显示一条提示。
''' 不会进行任何其他操作。
''' </summary>
Public Sub LoaderStateChangedHintOnly(Loader)
Select Case Loader.State
Case LoadState.Finished
Hint(Loader.Name & "成功!", HintType.Finish)
Case LoadState.Failed
Hint(Loader.Name & "失败:" & GetExceptionSummary(Loader.Error), HintType.Critical)
Case LoadState.Aborted
Hint(Loader.Name & "已取消!", HintType.Info)
End Select
End Sub
''' <summary> ''' <summary>
''' 安装加载器状态改变后进行提示和重载文件夹列表的方法。 ''' 安装加载器状态改变后进行提示和重载文件夹列表的方法。
''' </summary> ''' </summary>
@@ -1915,21 +2011,6 @@ Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
McInstallFailedClearFolder(Loader) McInstallFailedClearFolder(Loader)
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\") LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\")
End Sub End Sub
''' <summary>
''' 安装加载器状态改变后进行提示的方法。它不会在失败时删除文件夹,也不会刷新 MC 文件夹。
''' </summary>
Public Sub DownloadStateSave(Loader)
Select Case Loader.State
Case LoadState.Finished
Hint(Loader.Name & "成功!", HintType.Finish)
Case LoadState.Failed
Hint(Loader.Name & "失败:" & GetExceptionSummary(Loader.Error), HintType.Critical)
Case LoadState.Aborted
Hint(Loader.Name & "已取消!", HintType.Info)
Case LoadState.Loading
Exit Sub '不重新加载版本列表
End Select
End Sub
Public Sub McInstallFailedClearFolder(Loader) Public Sub McInstallFailedClearFolder(Loader)
Try Try
Thread.Sleep(1000) '防止存在尚未完全释放的文件,导致清理失败(例如整合包安装) Thread.Sleep(1000) '防止存在尚未完全释放的文件,导致清理失败(例如整合包安装)
@@ -1963,6 +2044,8 @@ Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
FrmMain.BtnExtraDownload.Ribble() FrmMain.BtnExtraDownload.Ribble()
Return True Return True
Catch ex As CancelledException
Return False
Catch ex As Exception Catch ex As Exception
Log(ex, "开始合并安装失败", LogLevel.Feedback) Log(ex, "开始合并安装失败", LogLevel.Feedback)
Return False Return False
@@ -1970,35 +2053,18 @@ Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
End Function End Function
''' <summary> ''' <summary>
''' 获取合并安装加载器列表,并进行前期的缓存清理与 Java 检查工作。 ''' 获取合并安装加载器列表,并进行前期的缓存清理与 Java 检查工作。
''' 如果出现已知问题且已提示用户,则返回 Nothing。出现异常则直接抛出。
''' </summary> ''' </summary>
''' <exception cref="CancelledException" />
Public Function McInstallLoader(Request As McInstallRequest, Optional DontFixLibraries As Boolean = False) As List(Of LoaderBase) Public Function McInstallLoader(Request As McInstallRequest, Optional DontFixLibraries As Boolean = False) As List(Of LoaderBase)
'获取缓存目录 '获取缓存目录(安装 Mod 加载器的文件夹不能包含空格)
Dim PathInstallTemp As String Dim TempMcFolder As String = RequestTaskTempFolder(Request.OptiFineEntry IsNot Nothing OrElse Request.ForgeEntry IsNot Nothing OrElse Request.NeoForgeEntry IsNot Nothing)
If PathTemp.Contains(" ") AndAlso (Request.OptiFineEntry IsNot Nothing OrElse Request.ForgeEntry IsNot Nothing OrElse Request.NeoForgeEntry IsNot Nothing) Then
PathInstallTemp = OsDrive & "ProgramData\PCL\Install\"
Else
PathInstallTemp = PathTemp & "Install\"
End If
'清理缓存
Try
If Not IsInstallTempCleared Then
IsInstallTempCleared = True
DeleteDirectory(PathInstallTemp, True)
Log("[Download] 已清理合并安装缓存")
End If
Catch ex As Exception
Log(ex, "清理合并安装缓存失败")
End Try
'获取参数 '获取参数
Dim OutputFolder As String = PathMcFolder & "versions\" & Request.TargetVersionName & "\" Dim VersionFolder As String = PathMcFolder & "versions\" & Request.TargetVersionName & "\"
Dim TempMcFolder As String = PathInstallTemp & Request.TargetVersionName.GetHashCode() & "\"
If Directory.Exists(TempMcFolder) Then DeleteDirectory(TempMcFolder) If Directory.Exists(TempMcFolder) Then DeleteDirectory(TempMcFolder)
Dim OptiFineFolder As String = Nothing Dim OptiFineFolder As String = Nothing
If Request.OptiFineVersion IsNot Nothing Then If Request.OptiFineVersion IsNot Nothing Then
If Request.OptiFineVersion.Contains("_HD_U_") Then Request.OptiFineVersion = "HD_U_" & Request.OptiFineVersion.After("_HD_U_") '#735 If Request.OptiFineVersion.Contains("_HD_U_") Then Request.OptiFineVersion = "HD_U_" & Request.OptiFineVersion.AfterLast("_HD_U_") '#735
Request.OptiFineEntry = New DlOptiFineListEntry With { Request.OptiFineEntry = New DlOptiFineListEntry With {
.NameDisplay = Request.MinecraftName & " " & Request.OptiFineVersion.Replace("HD_U_", "").Replace("_", "").Replace("pre", " pre"), .NameDisplay = Request.MinecraftName & " " & Request.OptiFineVersion.Replace("HD_U_", "").Replace("_", "").Replace("pre", " pre"),
.Inherit = Request.MinecraftName, .Inherit = Request.MinecraftName,
@@ -2020,14 +2086,17 @@ Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
Dim LiteLoaderFolder As String = Nothing Dim LiteLoaderFolder As String = Nothing
If Request.LiteLoaderEntry IsNot Nothing Then LiteLoaderFolder = TempMcFolder & "versions\" & Request.MinecraftName & "-LiteLoader" If Request.LiteLoaderEntry IsNot Nothing Then LiteLoaderFolder = TempMcFolder & "versions\" & Request.MinecraftName & "-LiteLoader"
'决定版本隔离情况(#5970)
Dim Modable As Boolean = Request.FabricVersion IsNot Nothing OrElse Request.ForgeEntry IsNot Nothing OrElse Request.NeoForgeEntry IsNot Nothing OrElse Request.LiteLoaderEntry IsNot Nothing
Dim Version As New McVersion(VersionFolder)
Version.InitPathIndie(Modable)
Dim ModsFolder As String = If(Modable, VersionFolder, PathMcFolder) & "mods\"
'判断 OptiFine 是否作为 Mod 进行下载 '判断 OptiFine 是否作为 Mod 进行下载
Dim MinecraftCode As Integer = If(Request.MinecraftName.Contains("."), Val(Request.MinecraftName.Split(".")(1)), 0) Dim OptiFineAsMod As Boolean = Request.OptiFineEntry IsNot Nothing AndAlso Modable '选择了 OptiFine 与任意 Mod 加载器
Dim OptiFineAsMod As Boolean = Request.OptiFineEntry IsNot Nothing AndAlso '1. 选择了 OptiFine
(Request.FabricVersion IsNot Nothing OrElse '2. 选择了 Fabric...
(Request.ForgeEntry IsNot Nothing AndAlso MinecraftCode >= 14 AndAlso MinecraftCode <= 15)) '...或者 Forge 1.14~15(#4134)
If OptiFineAsMod Then If OptiFineAsMod Then
Log("[Download] OptiFine 将作为 Mod 进行下载") Log("[Download] OptiFine 将作为 Mod 进行下载")
OptiFineFolder = New McVersion(OutputFolder).GetPathIndie(True) & "mods\" OptiFineFolder = ModsFolder
End If End If
'记录日志 '记录日志
@@ -2039,21 +2108,21 @@ Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
Log("[Download] 对应的原版版本:" & Request.MinecraftName) Log("[Download] 对应的原版版本:" & Request.MinecraftName)
'重复版本检查 '重复版本检查
If File.Exists(OutputFolder & Request.TargetVersionName & ".json") Then If File.Exists($"{VersionFolder}{Request.TargetVersionName}.json") Then
Hint("版本 " & Request.TargetVersionName & " 已经存在!", HintType.Critical) Hint("版本 " & Request.TargetVersionName & " 已经存在!", HintType.Critical)
Return Nothing Throw New CancelledException
End If End If
Dim LoaderList As New List(Of LoaderBase) Dim LoaderList As New List(Of LoaderBase)
'添加忽略标识 '添加忽略标识
LoaderList.Add(New LoaderTask(Of Integer, Integer)("添加忽略标识", Sub() WriteFile(OutputFolder & ".pclignore", "用于临时地在 PCL 的版本列表中屏蔽此版本。")) With {.Show = False, .Block = False}) LoaderList.Add(New LoaderTask(Of Integer, Integer)("添加忽略标识", Sub() WriteFile(VersionFolder & ".pclignore", "用于临时地在 PCL 的版本列表中屏蔽此版本。")) With {.Show = False, .Block = False})
'Fabric API 'Fabric API
If Request.FabricApi IsNot Nothing Then If Request.FabricApi IsNot Nothing Then
LoaderList.Add(New LoaderDownload("下载 Fabric API", New List(Of NetFile) From {Request.FabricApi.ToNetFile(New McVersion(OutputFolder).GetPathIndie(True) & "mods\")}) With {.ProgressWeight = 3, .Block = False}) LoaderList.Add(New LoaderDownload("下载 Fabric API", New List(Of NetFile) From {Request.FabricApi.ToNetFile(ModsFolder)}) With {.ProgressWeight = 3, .Block = False})
End If End If
'OptiFabric 'OptiFabric
If Request.OptiFabric IsNot Nothing Then If Request.OptiFabric IsNot Nothing Then
LoaderList.Add(New LoaderDownload("下载 OptiFabric", New List(Of NetFile) From {Request.OptiFabric.ToNetFile(New McVersion(OutputFolder).GetPathIndie(True) & "mods\")}) With {.ProgressWeight = 3, .Block = False}) LoaderList.Add(New LoaderDownload("下载 OptiFabric", New List(Of NetFile) From {Request.OptiFabric.ToNetFile(ModsFolder)}) With {.ProgressWeight = 3, .Block = False})
End If End If
'原版 '原版
Dim ClientLoader = New LoaderCombo(Of String)("下载原版 " & Request.MinecraftName, McDownloadClientLoader(Request.MinecraftName, Request.MinecraftJson, Request.TargetVersionName)) With {.Show = False, .ProgressWeight = 39, .Block = Request.ForgeVersion Is Nothing AndAlso Request.OptiFineEntry Is Nothing AndAlso Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing} Dim ClientLoader = New LoaderCombo(Of String)("下载原版 " & Request.MinecraftName, McDownloadClientLoader(Request.MinecraftName, Request.MinecraftJson, Request.TargetVersionName)) With {.Show = False, .ProgressWeight = 39, .Block = Request.ForgeVersion Is Nothing AndAlso Request.OptiFineEntry Is Nothing AndAlso Request.FabricVersion Is Nothing AndAlso Request.LiteLoaderEntry Is Nothing}
@@ -2085,25 +2154,29 @@ Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
'合并安装 '合并安装
LoaderList.Add(New LoaderTask(Of String, String)("安装游戏", LoaderList.Add(New LoaderTask(Of String, String)("安装游戏",
Sub(Task As LoaderTask(Of String, String)) Sub(Task As LoaderTask(Of String, String))
InstallMerge(OutputFolder, OutputFolder, OptiFineFolder, OptiFineAsMod, ForgeFolder, Request.ForgeVersion, NeoForgeFolder, Request.NeoForgeVersion, FabricFolder, LiteLoaderFolder) InstallMerge(VersionFolder, VersionFolder, OptiFineFolder, OptiFineAsMod, ForgeFolder, Request.ForgeVersion, NeoForgeFolder, Request.NeoForgeVersion, FabricFolder, LiteLoaderFolder)
Task.Progress = 0.3 Task.Progress = 0.3
If Directory.Exists(TempMcFolder & "libraries") Then CopyDirectory(TempMcFolder & "libraries", PathMcFolder & "libraries") If Directory.Exists(TempMcFolder & "libraries") Then CopyDirectory(TempMcFolder & "libraries", PathMcFolder & "libraries")
If Directory.Exists(TempMcFolder & "mods") Then CopyDirectory(TempMcFolder & "mods", PathMcFolder & "mods") If Directory.Exists(TempMcFolder & "mods") Then CopyDirectory(TempMcFolder & "mods", ModsFolder)
'新建 mods 文件夹
If Request.ForgeVersion IsNot Nothing OrElse Request.FabricVersion IsNot Nothing OrElse Request.NeoForgeEntry IsNot Nothing OrElse Request.LiteLoaderEntry IsNot Nothing Then
Directory.CreateDirectory(ModsFolder)
Log("[Download] 自动创建 mods 文件夹:" & ModsFolder)
End If
End Sub) With {.ProgressWeight = 2, .Block = True}) End Sub) With {.ProgressWeight = 2, .Block = True})
'补全文件 '补全文件
If Not DontFixLibraries AndAlso If Not DontFixLibraries AndAlso
(Request.OptiFineEntry IsNot Nothing OrElse (Request.ForgeVersion IsNot Nothing AndAlso Request.ForgeVersion.Before(".") >= 20) OrElse Request.NeoForgeVersion IsNot Nothing OrElse Request.FabricVersion IsNot Nothing OrElse Request.LiteLoaderEntry IsNot Nothing) Then (Request.OptiFineEntry IsNot Nothing OrElse (Request.ForgeVersion IsNot Nothing AndAlso Request.ForgeVersion.BeforeFirst(".") >= 20) OrElse Request.NeoForgeVersion IsNot Nothing OrElse Request.FabricVersion IsNot Nothing OrElse Request.LiteLoaderEntry IsNot Nothing) Then
Dim LoadersLib As New List(Of LoaderBase) Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(OutputFolder))) With {.ProgressWeight = 1, .Show = False}) LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionFolder))) With {.ProgressWeight = 1, .Show = False})
LoadersLib.Add(New LoaderDownload("下载游戏支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False}) LoadersLib.Add(New LoaderDownload("下载游戏支持库文件(副加载器)", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
LoaderList.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8}) LoaderList.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
End If End If
'删除忽略标识 '删除忽略标识
LoaderList.Add(New LoaderTask(Of Integer, Integer)("删除忽略标识", Sub() File.Delete(OutputFolder & ".pclignore")) With {.Show = False}) LoaderList.Add(New LoaderTask(Of Integer, Integer)("删除忽略标识", Sub() File.Delete(VersionFolder & ".pclignore")) With {.Show = False})
'总加载器 '总加载器
Return LoaderList Return LoaderList
End Function End Function
Private IsInstallTempCleared As Boolean = False
''' <summary> ''' <summary>
''' 将多个版本 Json 进行合并,如果目标已存在则直接覆盖。失败会抛出异常。 ''' 将多个版本 Json 进行合并,如果目标已存在则直接覆盖。失败会抛出异常。
@@ -39,7 +39,7 @@
Version("id") = "20w14∞" Version("id") = "20w14∞"
Version("type") = "special" Version("type") = "special"
Version.Add("lore", GetMcFoolName(Version("id"))) Version.Add("lore", GetMcFoolName(Version("id")))
Case "3d shareware v1.34", "1.rv-pre1", "15w14a", "2.0", "22w13oneblockatatime", "23w13a_or_b", "24w14potato" Case "3d shareware v1.34", "1.rv-pre1", "15w14a", "2.0", "22w13oneblockatatime", "23w13a_or_b", "24w14potato", "25w14craftmine"
Type = "愚人节版" Type = "愚人节版"
Version("type") = "special" Version("type") = "special"
Version.Add("lore", GetMcFoolName(Version("id"))) Version.Add("lore", GetMcFoolName(Version("id")))
@@ -61,8 +61,7 @@
Next Next
'排序 '排序
For i = 0 To Dict.Keys.Count - 1 For i = 0 To Dict.Keys.Count - 1
Dict(Dict.Keys(i)) = Sort(Dict.Values(i), Dict(Dict.Keys(i)) = Dict.Values(i).OrderByDescending(Function(v) v("releaseTime").Value(Of Date)).ToList
Function(a, b) a("releaseTime").Value(Of Date) > b("releaseTime").Value(Of Date))
Next Next
'清空当前 '清空当前
PanMain.Children.Clear() PanMain.Children.Clear()
@@ -9,7 +9,6 @@
<Grid.RowDefinitions> <Grid.RowDefinitions>
<RowDefinition Height="Auto" /> <RowDefinition Height="Auto" />
<RowDefinition Height="1*" /> <RowDefinition Height="1*" />
<RowDefinition Height="Auto" />
</Grid.RowDefinitions> </Grid.RowDefinitions>
<local:MyCard Margin="0,0,0,25" x:Name="CardIntro"> <local:MyCard Margin="0,0,0,25" x:Name="CardIntro">
<StackPanel Margin="22,18,22,19" x:Name="PanIntro"> <StackPanel Margin="22,18,22,19" x:Name="PanIntro">
@@ -20,7 +19,12 @@
</StackPanel> </StackPanel>
</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:MyCard Margin="0,0,0,15" x:Name="CardFilter">
<StackPanel x:Name="PanFilter" Margin="10,10,0,10" Orientation="Horizontal" VerticalAlignment="Top" HorizontalAlignment="Left" />
</local:MyCard>
<StackPanel Name="PanResults" />
</StackPanel>
<local:MyCard Grid.Row="1" HorizontalAlignment="Center" VerticalAlignment="Center" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False" Margin="0,0,0,8"> <local:MyCard Grid.Row="1" HorizontalAlignment="Center" VerticalAlignment="Center" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False" Margin="0,0,0,8">
<local:MyLoading Text="正在获取版本列表" Margin="20,20,20,17" x:Name="Load" HorizontalAlignment="Center" VerticalAlignment="Center" /> <local:MyLoading Text="正在获取版本列表" Margin="20,20,20,17" x:Name="Load" HorizontalAlignment="Center" VerticalAlignment="Center" />
</local:MyCard> </local:MyCard>
@@ -34,41 +34,120 @@
End Select End Select
End Sub End Sub
'结果 UI 化 '结果 UI 化
Private Class VersionSorterWithSelect Private Class CardSorter
Implements IComparer(Of String) Implements IComparer(Of String)
Public Top As String = "" Public Topmost As String = ""
Public Function Compare(x As String, y As String) As Integer Implements IComparer(Of String).Compare Public Function Compare(x As String, y As String) As Integer Implements IComparer(Of String).Compare
'相同
If x = y Then Return 0 If x = y Then Return 0
If x = Top Then Return -1 '置顶
If y = Top Then Return 1 If x = Topmost Then Return -1
If y = Topmost Then Return 1
'特殊版本
Dim IsXSpecial As Boolean = x.EndsWithF("版本")
Dim IsYSpecial As Boolean = y.EndsWithF("版本")
If IsXSpecial AndAlso IsYSpecial Then Return x.CompareTo(y)
If IsXSpecial Then Return 1
If IsYSpecial Then Return -1
'比较版本号
Dim VersionCodeSort = -VersionSortInteger(x.Replace(x.BeforeFirst(" ") & " ", ""), y.Replace(y.BeforeFirst(" ") & " ", ""))
If VersionCodeSort <> 0 Then Return VersionCodeSort
'比较全部
Return -VersionSortInteger(x, y) Return -VersionSortInteger(x, y)
End Function End Function
Public Sub New(Optional Top As String = "") Public Sub New(Optional Topmost As String = "")
Me.Top = If(Top, "") Me.Topmost = If(Topmost, "")
End Sub End Sub
End Class End Class
Private VersionFilter As String
Private IsMajorVersionFilter As Boolean '是否按大版本号筛选(1.21 / 1.20 / 1.19 / ...)而非小版本号(1.21.1 / 1.21 / 1.20.4 / ...)
Private Sub Load_OnFinish() Private Sub Load_OnFinish()
'初始化筛选器
Dim VersionFilters As List(Of String)
'按小版本号筛选?
IsMajorVersionFilter = False
VersionFilters = CompFileLoader.Output.SelectMany(Function(v) v.GameVersions).Select(Function(v) GetGroupedVersionName(v, IsMajorVersionFilter, True)).
Distinct.OrderByDescending(Function(s) s, New VersionComparer).ToList
'按大版本号筛选?
If VersionFilters.Count >= 9 Then
IsMajorVersionFilter = True
VersionFilters = CompFileLoader.Output.SelectMany(Function(v) v.GameVersions).Select(Function(v) GetGroupedVersionName(v, IsMajorVersionFilter, True)).
Distinct.OrderByDescending(Function(s) s, New VersionComparer).ToList
End If
'UI 化筛选器
PanFilter.Children.Clear()
If VersionFilters.Count < 2 Then
CardFilter.Visibility = Visibility.Collapsed
VersionFilter = Nothing
Else
CardFilter.Visibility = Visibility.Visible
VersionFilters.Insert(0, "全部")
'转化为按钮
For Each Version As String In VersionFilters
Dim NewButton As New MyRadioButton With {
.Text = Version, .Margin = New Thickness(2, 0, 2, 0), .ColorType = MyRadioButton.ColorState.Highlight}
NewButton.LabText.Margin = New Thickness(-2, 0, 8, 0)
AddHandler NewButton.Check,
Sub(sender As MyRadioButton, raiseByMouse As Boolean)
VersionFilter = If(sender.Text = "全部", Nothing, sender.Text)
UpdateFilterResult()
End Sub
PanFilter.Children.Add(NewButton)
Next
'自动选择
Dim ToCheck As MyRadioButton = Nothing
If TargetVersion <> "" Then
Dim TargetFile = CompFileLoader.Output.FirstOrDefault(Function(v) v.GameVersions.Contains(TargetVersion))
If TargetFile IsNot Nothing Then
Dim TargetGroup = GetGroupedVersionName(TargetVersion, IsMajorVersionFilter, True)
For Each Button As MyRadioButton In PanFilter.Children
If Button.Text <> TargetGroup Then Continue For
ToCheck = Button
Exit For
Next
End If
End If
If ToCheck Is Nothing Then ToCheck = PanFilter.Children(0)
ToCheck.Checked = True
End If
'更新筛选结果(文件列表 UI 化)
UpdateFilterResult()
End Sub
Private Sub UpdateFilterResult()
Dim TargetCardName As String = If(TargetVersion <> "" OrElse TargetLoader <> CompModLoaderType.Any, Dim TargetCardName As String = If(TargetVersion <> "" OrElse TargetLoader <> CompModLoaderType.Any,
$"所选版本:{TargetVersion} {If(TargetLoader <> CompModLoaderType.Any, TargetLoader, "")}", "") $"所选版本:{If(TargetLoader <> CompModLoaderType.Any, TargetLoader.ToString & " ", "")}{TargetVersion}", "")
'初始化字典 '归类到卡片下
Dim Dict As New SortedDictionary(Of String, List(Of CompFile))(New VersionSorterWithSelect(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)))
For Each Version As CompFile In CompFileLoader.Output For Each Version As CompFile In CompFileLoader.Output
For Each GameVersion In Version.GameVersions For Each GameVersion In Version.GameVersions
'决定添加到哪个版本 '检查是否符合版本筛选器
Dim TargetCard As String If VersionFilter IsNot Nothing AndAlso
If GameVersion Is Nothing Then GetGroupedVersionName(GameVersion, IsMajorVersionFilter, True) <> VersionFilter Then Continue For
TargetCard = "未知版本" '决定添加到哪个卡片
ElseIf GameVersion.Contains("w") OrElse GameVersion.Contains("pre") OrElse GameVersion.Contains("rc") Then Dim Ver As String = GetGroupedVersionName(GameVersion, False, False)
TargetCard = "快照版本" '遍历加入的加载器列表
ElseIf GameVersion.StartsWith("1.0") Then Dim Loaders As New List(Of String)
TargetCard = "远古版本" If Project.ModLoaders.Count > 1 AndAlso '至少有两个加载器
Else Project.Type = CompType.Mod AndAlso '是 Mod
TargetCard = GameVersion Ver.StartsWith("1.") Then '不是 “快照版本” 之类的
For Each Loader In Version.ModLoaders
If Loader = CompModLoaderType.Quilt AndAlso Setup.Get("ToolDownloadIgnoreQuilt") Then Continue For
If SupportedLoaders.Contains(Loader) Then Loaders.Add(Loader.ToString & " ")
Next
End If End If
'实际进行添加 If Not Loaders.Any() Then Loaders.Add("") '保底加一个空的,确保它在一张卡片里
If Not Dict.ContainsKey(TargetCard) Then Dict.Add(TargetCard, New List(Of CompFile)) '实际添加
If Not Dict(TargetCard).Contains(Version) Then Dict(TargetCard).Add(Version) For Each Loader In Loaders
Dim TargetCard As String = Loader & Ver
If Not Dict.ContainsKey(TargetCard) Then Dict.Add(TargetCard, New List(Of CompFile))
If Not Dict(TargetCard).Contains(Version) Then Dict(TargetCard).Add(Version)
Next
Next Next
Next Next
'添加筛选的版本的卡片 '添加筛选的版本的卡片
@@ -77,16 +156,16 @@
For Each Version As CompFile In CompFileLoader.Output For Each Version As CompFile In CompFileLoader.Output
If Version.GameVersions.Contains(TargetVersion) AndAlso If Version.GameVersions.Contains(TargetVersion) AndAlso
(TargetLoader = CompModLoaderType.Any OrElse Version.ModLoaders.Contains(TargetLoader)) Then (TargetLoader = CompModLoaderType.Any OrElse Version.ModLoaders.Contains(TargetLoader)) Then
'检查是否符合版本筛选器
If VersionFilter IsNot Nothing AndAlso
Not Version.GameVersions.Any(Function(v) GetGroupedVersionName(v, IsMajorVersionFilter, True) = 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
End If End If
'转化为 UI
#Region "转化为 UI"
Try Try
'清空当前 PanResults.Children.Clear()
PanMain.Children.Clear()
'转化为 UI
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
'增加卡片 '增加卡片
@@ -94,7 +173,7 @@
Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Pair.Value} 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
PanMain.Children.Add(NewCard) PanResults.Children.Add(NewCard)
'确定卡片是否展开 '确定卡片是否展开
If Pair.Key = TargetCardName OrElse If Pair.Key = TargetCardName OrElse
(FrmMain.PageCurrent.Additional IsNot Nothing AndAlso '#2761 (FrmMain.PageCurrent.Additional IsNot Nothing AndAlso '#2761
@@ -104,20 +183,29 @@
NewCard.IsSwaped = True NewCard.IsSwaped = True
End If End If
'增加提示 '增加提示
If Pair.Key = "未知版本" Then If Pair.Key = "其他版本" Then
NewStack.Children.Add(New MyHint With {.Text = "由于 API 的版本信息更新缓慢,可能无法识别刚更新不久的 MC 版本,只需等待几天即可自动恢复正常。", .IsWarn = False, .Margin = New Thickness(0, 0, 0, 7)}) NewStack.Children.Add(New MyHint With {.Text = "由于版本信息更新缓慢,可能无法识别刚更新的 MC 版本,只需等待几天即可自动恢复正常。", .IsWarn = False, .Margin = New Thickness(0, 0, 0, 7)})
End If End If
Next Next
'如果只有一张卡片,展开第一张卡片 '如果只有一张卡片,展开第一张卡片
If PanMain.Children.Count = 1 Then If PanResults.Children.Count = 1 Then
CType(PanMain.Children(0), MyCard).IsSwaped = False CType(PanResults.Children(0), MyCard).IsSwaped = False
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 Region
End Sub End Sub
Private Function GetGroupedVersionName(Name As String, MajorOnly As Boolean, FoldOldRelease As Boolean) As String
If Name Is Nothing Then
Return "其他版本"
ElseIf Name.Contains("w") Then
Return "快照版本"
ElseIf Name.StartsWith("1.0") OrElse Not Name.StartsWith("1.") OrElse (FoldOldRelease AndAlso Val(Name.Split(".")(1)) < 10) Then
Return "远古版本"
Else
Return If(MajorOnly, "1." & Name.Split(".")(1).BeforeFirst(" "), Name)
End If
End Function
#End Region #End Region
@@ -167,14 +255,10 @@
'构造步骤加载器 '构造步骤加载器
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 = $"{PathMcFolder}versions\{VersionName}\原始整合包.{If(Project.FromCurseForge, "zip", "mrpack")}"
Dim LogoFileAddress As String = PathTemp & "CompLogo\" & GetHash(CompItem.Logo) & ".png" Dim LogoFileAddress As String = MyImage.GetTempPath(CompItem.Logo)
Loaders.Add(New LoaderDownload("下载整合包文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 10, .Block = True}) Loaders.Add(New LoaderDownload("下载整合包文件", New List(Of NetFile) From {File.ToNetFile(Target)}) With {.ProgressWeight = 10, .Block = True})
Loaders.Add(New LoaderTask(Of Integer, Integer)("准备安装整合包", Loaders.Add(New LoaderTask(Of Integer, Integer)("准备安装整合包",
Sub() Sub() ModpackInstall(Target, VersionName, If(IO.File.Exists(LogoFileAddress), LogoFileAddress, Nothing))) With {.ProgressWeight = 0.1})
If ModpackInstall(Target, VersionName, Logo:=If(IO.File.Exists(LogoFileAddress), LogoFileAddress, Nothing)) Is Nothing Then
Throw New Exception("整合包安装出现异常!")
End If
End Sub) With {.ProgressWeight = 0.1})
'启动 '启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged =
@@ -235,7 +319,7 @@
If Not Version.IsLoaded Then Version.Load() If Not Version.IsLoaded Then Version.Load()
If Not Version.Modable Then Return False If Not Version.Modable Then Return False
If File.GameVersions.Any(Function(v) v.Contains(".")) AndAlso If File.GameVersions.Any(Function(v) v.Contains(".")) AndAlso
Not File.GameVersions.Any(Function(v) v.Contains(".") AndAlso v.Split(".")(1) = Version.Version.McCodeMain.ToString) Then Return False Not File.GameVersions.Any(Function(v) v.Contains(".") AndAlso v = Version.Version.McName) Then Return False
If AllowForge Is Nothing OrElse AllowFabric Is Nothing Then Return True If AllowForge Is Nothing OrElse AllowFabric Is Nothing Then Return True
If AllowForge AndAlso (Version.Version.HasForge OrElse Version.Version.HasNeoForge) Then Return True If AllowForge AndAlso (Version.Version.HasForge OrElse Version.Version.HasNeoForge) Then Return True
If AllowFabric AndAlso Version.Version.HasFabric Then Return True If AllowFabric AndAlso Version.Version.HasFabric Then Return True
@@ -283,14 +367,16 @@
If Project.TranslatedName = Project.RawName Then If Project.TranslatedName = Project.RawName Then
FileName = File.FileName FileName = File.FileName
Else Else
Dim ChineseName As String = Project.TranslatedName.Before(" (").Before(" - "). 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("ToolDownloadTranslate") Select Case Setup.Get("ToolDownloadTranslateV2")
Case 0 Case 0
FileName = $"[{ChineseName}] {File.FileName}" FileName = $"【{ChineseName}】{File.FileName}"
Case 1 Case 1
FileName = $"{ChineseName}-{File.FileName}" FileName = $"[{ChineseName}] {File.FileName}"
Case 2 Case 2
FileName = $"{ChineseName}-{File.FileName}"
Case 3
FileName = $"{File.FileName}-{ChineseName}" FileName = $"{File.FileName}-{ChineseName}"
Case Else Case Else
FileName = File.FileName FileName = File.FileName
@@ -300,11 +386,11 @@
Sub() Sub()
'弹窗要求选择保存位置 '弹窗要求选择保存位置
Dim Target As String Dim Target As String
Target = SelectAs("选择保存位置", FileName, Target = SelectSaveFile("选择保存位置", FileName,
Desc & "文件|" & Desc & "文件|" &
If(Project.Type = CompType.Mod, If(Project.Type = CompType.Mod,
If(File.FileName.EndsWith(".litemod"), "*.litemod", "*.jar"), If(File.FileName.EndsWith(".litemod"), "*.litemod", "*.jar"),
If(File.FileName.EndsWith(".mrpack"), "*.mrpack", "*.zip")), DefaultFolder) If(File.FileName.EndsWith(".mrpack"), "*.mrpack", "*.zip")), DefaultFolder)
If Not Target.Contains("\") Then Exit Sub If Not Target.Contains("\") Then Exit Sub
'构造步骤加载器 '构造步骤加载器
Dim LoaderName As String = Desc & "下载:" & GetFileNameWithoutExtentionFromPath(Target) & " " Dim LoaderName As String = Desc & "下载:" & GetFileNameWithoutExtentionFromPath(Target) & " "
@@ -312,7 +398,7 @@
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})
'启动 '启动
Dim Loader As New LoaderCombo(Of Integer)(LoaderName, Loaders) With {.OnStateChanged = AddressOf DownloadStateSave} Dim Loader As New LoaderCombo(Of Integer)(LoaderName, Loaders) With {.OnStateChanged = AddressOf LoaderStateChangedHintOnly}
Loader.Start(1) Loader.Start(1)
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
@@ -331,7 +417,7 @@
OpenWebsite("https://www.mcmod.cn/class/" & Project.WikiId & ".html") OpenWebsite("https://www.mcmod.cn/class/" & Project.WikiId & ".html")
End Sub End Sub
Private Sub BtnIntroCopy_Click(sender As Object, e As EventArgs) Handles BtnIntroCopy.Click Private Sub BtnIntroCopy_Click(sender As Object, e As EventArgs) Handles BtnIntroCopy.Click
ClipboardSet(CompItem.LabTitle.Text) ClipboardSet(CompItem.LabTitle.Text & CompItem.LabTitleRaw.Text)
End Sub End Sub
End Class End Class
@@ -10,12 +10,10 @@
Private Sub Load_OnFinish() Private Sub Load_OnFinish()
'结果数据化 '结果数据化
Try Try
'排序
Dim Versions = Sort(DlForgeListLoader.Output.Value, AddressOf VersionSortBoolean)
'清空当前 '清空当前
PanMain.Children.Clear() PanMain.Children.Clear()
'转化为 UI '转化为 UI
For Each Version As String In Versions 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 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} Dim NewStack As New StackPanel With {.Margin = New Thickness(20, MyCard.SwapedHeight, 18, 0), .VerticalAlignment = VerticalAlignment.Top, .RenderTransform = New TranslateTransform(0, 0), .Tag = Version}
@@ -5,66 +5,31 @@
mc:Ignorable="d" x:Class="PageDownloadInstall" mc:Ignorable="d" x:Class="PageDownloadInstall"
PanScroll="{Binding ElementName=PanBack}"> PanScroll="{Binding ElementName=PanBack}">
<Grid> <Grid>
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack"> <Grid Name="PanAllBack">
<Grid Margin="25,10,25,25"> <local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Grid.Row="1" Name="PanMinecraft" Grid.IsSharedSizeScope="True" Margin="0,0,0,-10"> <Grid Margin="25,10,25,25" Name="PanInner">
<StackPanel.RenderTransform> <StackPanel Grid.Row="1" Name="PanMinecraft" Grid.IsSharedSizeScope="True" Margin="0,0,0,-10">
<TranslateTransform /> <StackPanel.RenderTransform>
</StackPanel.RenderTransform> <TranslateTransform />
</StackPanel> </StackPanel.RenderTransform>
<StackPanel Grid.Row="1" x:Name="PanSelect" Visibility="Collapsed" Opacity="0" IsHitTestVisible="False"> </StackPanel>
<StackPanel.RenderTransform> <StackPanel Grid.Row="1" x:Name="PanSelect" Visibility="Collapsed" Opacity="0" IsHitTestVisible="False" Margin="0,0,0,45">
<TranslateTransform X="40" /> <StackPanel.RenderTransform>
</StackPanel.RenderTransform> <TranslateTransform X="40" />
<local:MyCard Title="安装预览" Margin="0,15,0,0" UseAnimation="False"> </StackPanel.RenderTransform>
<StackPanel Margin="25,37,25,15"> <local:MyCard Margin="0,15,0,15" UseAnimation="False" Height="62">
<local:MyHint Text="你尚未选择安装 Fabric API,这会导致大多数 Mod 无法使用!" Margin="0,1,0,7" x:Name="HintFabricAPI" IsWarn="True" /> <local:MyIconButton HorizontalAlignment="Left" Theme="Black" Opacity="0.6" x:Name="BtnBack" Margin="13,0,0,0" Height="26" Width="26"
<local:MyHint Text="你尚未选择安装 OptiFabric,这会导致 OptiFine 无法使用!" Margin="0,1,0,7" x:Name="HintOptiFabric" IsWarn="True" /> LogoScale="0.87" Logo="M1097 584 250 584 562 896C591 925 591 972 562 1001 533 1030 487 1030 458 1001L21 565C6 550-0 531 0 511L0 511 0 511C-0 492 6 472 21 457L458 21C487-7 533-7 562 21 591 50 591 97 562 126L250 438 1097 438C1137 438 1170 471 1170 511 1170 551 1137 584 1097 584L1097 584Z" />
<local:MyHint Text="安装结束后,请在 Mod 下载中搜索 OptiFabric Origins 并下载,否则 OptiFine 会无法使用!" Margin="0,1,0,7" x:Name="HintOptiFabricOld" IsWarn="False" /> <local:MyImage x:Name="ImgLogo" Margin="52,0,0,0" VerticalAlignment="Center" HorizontalAlignment="Left" Height="32" RenderOptions.BitmapScalingMode="HighQuality" />
<local:MyHint Text="OptiFine 与一部分 Mod 的兼容性不佳,请谨慎安装。" Margin="0,1,0,7" x:Name="HintModOptiFine" IsWarn="False" /> <local:MyTextBox Margin="93,0,16,0" Padding="-1,0" MinHeight="30" FontSize="15" VerticalAlignment="Center" x:Name="TextSelectName" MaxLength="70" HasBackground="False" />
<Grid Margin="0,0,0,11"> </local:MyCard>
<Grid.ColumnDefinitions> <local:MyHint Text="如果不安装 Fabric API,大多数 Mod 都会无法使用!" Margin="0,10,0,0" x:Name="HintFabricAPI" IsWarn="True" />
<ColumnDefinition Width="1*" /> <local:MyHint Text="必须安装 OptiFabric 才能正常使用 OptiFine!" Margin="0,10,0,0" x:Name="HintOptiFabric" IsWarn="True" />
<ColumnDefinition Width="Auto" /> <local:MyHint Text="安装结束后,请在 Mod 下载中搜索 OptiFabric Origins 并下载,否则 OptiFine 会无法使用!" Margin="0,10,0,0" x:Name="HintOptiFabricOld" IsWarn="False" />
</Grid.ColumnDefinitions> <local:MyHint Text="OptiFine 与一部分 Mod 的兼容性不佳,请谨慎安装。" Margin="0,10,0,0" x:Name="HintModOptiFine" IsWarn="False" />
<local:MyListItem Grid.Column="0" x:Name="ItemSelect" IsHitTestVisible="False" Margin="-7,0,0,0" Height="42" SnapsToDevicePixels="True" Type="None" /> <local:MyCard Title="Forge" Height="40" Margin="0,12,0,0" x:Name="CardForge" IsSwaped="True" CanSwap="True" SwapLogoRight="True">
<local:MyButton Grid.Column="1" HorizontalAlignment="Right" ColorType="Highlight" Text="开始安装" Margin="0,2,0,0" x:Name="BtnSelectStart" MinWidth="140" Padding="13,0" Height="35" VerticalAlignment="Center" />
</Grid>
<Grid Margin="0,0,0,5">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Name" />
<ColumnDefinition />
</Grid.ColumnDefinitions>
<TextBlock VerticalAlignment="Top" HorizontalAlignment="Left" Text="版本名称" Margin="0,5,25,0" />
<local:MyTextBox Grid.Column="1" x:Name="TextSelectName" MinHeight="28" />
</Grid>
</StackPanel>
</local:MyCard>
<local:MyCard Title="Minecraft" Height="40" Margin="0,15,0,0" x:Name="CardMinecraft">
<Grid x:Name="PanMinecraftInfo" Height="18" Margin="175,11,15,0" VerticalAlignment="Top">
<Grid.RenderTransform>
<TranslateTransform />
</Grid.RenderTransform>
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="Auto" />
</Grid.ColumnDefinitions>
<Image x:Name="ImgMinecraft" Margin="0,0,7,0" SnapsToDevicePixels="True" Height="18" RenderOptions.BitmapScalingMode="Linear" />
<TextBlock x:Name="LabMinecraft" VerticalAlignment="Center" TextTrimming="CharacterEllipsis" Grid.Column="1" />
<Path Data="M2,4 l-2,2 10,10 10,-10 -2,-2 -8,8 -8,-8 z" Height="6" Width="10" Stretch="Uniform" VerticalAlignment="Center"
Grid.Column="2" Fill="{StaticResource ColorBrushGray4}" Margin="0,1,6,0" RenderTransformOrigin="0.5,0.5">
<Path.RenderTransform>
<RotateTransform Angle="90" />
</Path.RenderTransform>
</Path>
<TextBlock VerticalAlignment="Center" Text="返回" Grid.Column="3" Foreground="{StaticResource ColorBrushGray4}" />
</Grid>
</local:MyCard>
<local:MyCard Title="Forge" Height="40" Margin="0,15,0,0" x:Name="CardForge" IsSwaped="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="175,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>
<TranslateTransform /> <TranslateTransform />
</Grid.RenderTransform> </Grid.RenderTransform>
@@ -77,12 +42,12 @@
</Grid> </Grid>
<Grid x:Name="BtnForgeClear" Height="30" Width="30" HorizontalAlignment="Right" VerticalAlignment="Top" Margin="0,5,32,0" Background="{StaticResource ColorBrushSemiTransparent}"> <Grid x:Name="BtnForgeClear" Height="30" Width="30" HorizontalAlignment="Right" VerticalAlignment="Top" Margin="0,5,32,0" Background="{StaticResource ColorBrushSemiTransparent}">
<Path x:Name="BtnForgeClearInner" Height="10" Width="10" Stretch="Uniform" Fill="{StaticResource ColorBrushGray1}" HorizontalAlignment="Center" VerticalAlignment="Center" <Path x:Name="BtnForgeClearInner" Height="10" Width="10" Stretch="Uniform" Fill="{StaticResource ColorBrushGray1}" HorizontalAlignment="Center" VerticalAlignment="Center"
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,15,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" IsSwaped="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="175,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>
<TranslateTransform /> <TranslateTransform />
</Grid.RenderTransform> </Grid.RenderTransform>
@@ -95,12 +60,12 @@
</Grid> </Grid>
<Grid x:Name="BtnNeoForgeClear" Height="30" Width="30" HorizontalAlignment="Right" VerticalAlignment="Top" Margin="0,5,32,0" Background="{StaticResource ColorBrushSemiTransparent}"> <Grid x:Name="BtnNeoForgeClear" Height="30" Width="30" HorizontalAlignment="Right" VerticalAlignment="Top" Margin="0,5,32,0" Background="{StaticResource ColorBrushSemiTransparent}">
<Path x:Name="BtnNeoForgeClearInner" Height="10" Width="10" Stretch="Uniform" Fill="{StaticResource ColorBrushGray1}" HorizontalAlignment="Center" VerticalAlignment="Center" <Path x:Name="BtnNeoForgeClearInner" Height="10" Width="10" Stretch="Uniform" Fill="{StaticResource ColorBrushGray1}" HorizontalAlignment="Center" VerticalAlignment="Center"
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,15,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" IsSwaped="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="175,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>
<TranslateTransform /> <TranslateTransform />
</Grid.RenderTransform> </Grid.RenderTransform>
@@ -113,12 +78,12 @@
</Grid> </Grid>
<Grid x:Name="BtnFabricClear" Height="30" Width="30" HorizontalAlignment="Right" VerticalAlignment="Top" Margin="0,5,32,0" Background="{StaticResource ColorBrushSemiTransparent}"> <Grid x:Name="BtnFabricClear" Height="30" Width="30" HorizontalAlignment="Right" VerticalAlignment="Top" Margin="0,5,32,0" Background="{StaticResource ColorBrushSemiTransparent}">
<Path x:Name="BtnFabricClearInner" Height="10" Width="10" Stretch="Uniform" Fill="{StaticResource ColorBrushGray1}" HorizontalAlignment="Center" VerticalAlignment="Center" <Path x:Name="BtnFabricClearInner" Height="10" Width="10" Stretch="Uniform" Fill="{StaticResource ColorBrushGray1}" HorizontalAlignment="Center" VerticalAlignment="Center"
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,15,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" IsSwaped="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="175,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>
<TranslateTransform /> <TranslateTransform />
</Grid.RenderTransform> </Grid.RenderTransform>
@@ -131,14 +96,14 @@
</Grid> </Grid>
<Grid x:Name="BtnFabricApiClear" Height="30" Width="30" HorizontalAlignment="Right" VerticalAlignment="Top" Margin="0,5,32,0" Background="{StaticResource ColorBrushSemiTransparent}"> <Grid x:Name="BtnFabricApiClear" Height="30" Width="30" HorizontalAlignment="Right" VerticalAlignment="Top" Margin="0,5,32,0" Background="{StaticResource ColorBrushSemiTransparent}">
<Path x:Name="BtnFabricApiClearInner" Height="10" Width="10" Stretch="Uniform" Fill="{StaticResource ColorBrushGray1}" HorizontalAlignment="Center" VerticalAlignment="Center" <Path x:Name="BtnFabricApiClearInner" Height="10" Width="10" Stretch="Uniform" Fill="{StaticResource ColorBrushGray1}" HorizontalAlignment="Center" VerticalAlignment="Center"
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,15,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" IsSwaped="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>
<Grid x:Name="PanOptiFineInfo" Height="18" Margin="175,11,15,0" VerticalAlignment="Top" Tag="True"> <Grid x:Name="PanOptiFineInfo" Height="18" Margin="132,11,15,0" VerticalAlignment="Top" Tag="True">
<Grid.RenderTransform> <Grid.RenderTransform>
<TranslateTransform /> <TranslateTransform />
</Grid.RenderTransform> </Grid.RenderTransform>
@@ -151,12 +116,12 @@
</Grid> </Grid>
<Grid x:Name="BtnOptiFineClear" Height="30" Width="30" HorizontalAlignment="Right" VerticalAlignment="Top" Margin="0,5,32,0" Background="{StaticResource ColorBrushSemiTransparent}"> <Grid x:Name="BtnOptiFineClear" Height="30" Width="30" HorizontalAlignment="Right" VerticalAlignment="Top" Margin="0,5,32,0" Background="{StaticResource ColorBrushSemiTransparent}">
<Path x:Name="BtnOptiFineClearInner" Height="10" Width="10" Stretch="Uniform" Fill="{StaticResource ColorBrushGray1}" HorizontalAlignment="Center" VerticalAlignment="Center" <Path x:Name="BtnOptiFineClearInner" Height="10" Width="10" Stretch="Uniform" Fill="{StaticResource ColorBrushGray1}" HorizontalAlignment="Center" VerticalAlignment="Center"
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,15,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" IsSwaped="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="175,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>
<TranslateTransform /> <TranslateTransform />
</Grid.RenderTransform> </Grid.RenderTransform>
@@ -169,12 +134,12 @@
</Grid> </Grid>
<Grid x:Name="BtnOptiFabricClear" Height="30" Width="30" HorizontalAlignment="Right" VerticalAlignment="Top" Margin="0,5,32,0" Background="{StaticResource ColorBrushSemiTransparent}"> <Grid x:Name="BtnOptiFabricClear" Height="30" Width="30" HorizontalAlignment="Right" VerticalAlignment="Top" Margin="0,5,32,0" Background="{StaticResource ColorBrushSemiTransparent}">
<Path x:Name="BtnOptiFabricClearInner" Height="10" Width="10" Stretch="Uniform" Fill="{StaticResource ColorBrushGray1}" HorizontalAlignment="Center" VerticalAlignment="Center" <Path x:Name="BtnOptiFabricClearInner" Height="10" Width="10" Stretch="Uniform" Fill="{StaticResource ColorBrushGray1}" HorizontalAlignment="Center" VerticalAlignment="Center"
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,15,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" IsSwaped="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="175,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>
<TranslateTransform /> <TranslateTransform />
</Grid.RenderTransform> </Grid.RenderTransform>
@@ -187,12 +152,16 @@
</Grid> </Grid>
<Grid x:Name="BtnLiteLoaderClear" Height="30" Width="30" HorizontalAlignment="Right" VerticalAlignment="Top" Margin="0,5,32,0" Background="{StaticResource ColorBrushSemiTransparent}"> <Grid x:Name="BtnLiteLoaderClear" Height="30" Width="30" HorizontalAlignment="Right" VerticalAlignment="Top" Margin="0,5,32,0" Background="{StaticResource ColorBrushSemiTransparent}">
<Path x:Name="BtnLiteLoaderClearInner" Height="10" Width="10" Stretch="Uniform" Fill="{StaticResource ColorBrushGray1}" HorizontalAlignment="Center" VerticalAlignment="Center" <Path x:Name="BtnLiteLoaderClearInner" Height="10" Width="10" Stretch="Uniform" Fill="{StaticResource ColorBrushGray1}" HorizontalAlignment="Center" VerticalAlignment="Center"
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>
</StackPanel> </StackPanel>
</Grid> </Grid>
</local:MyScrollViewer> </local:MyScrollViewer>
<local:MyExtraTextButton x:Name="BtnStart" Text="开始下载"
HorizontalAlignment="Center" VerticalAlignment="Bottom"
LogoScale="0.95" Logo="M955 610h-59c-15 0-29 13-29 29v196c0 15-13 29-29 29h-649c-15 0-29-13-29-29v-196c0-15-13-29-29-29h-59c-15 0-29 13-29 29V905c0 43 35 78 78 78h787c43 0 78-35 78-78V640c0-15-13-29-29-29zM492 740c11 11 29 11 41 0l265-265c11-11 11-29 0-41l-41-41c-11-11-29-11-41 0l-110 110c-11 11-33 3-33-13V68C571 53 555 39 541 39h-59c-15 0-29 13-29 29v417c0 17-21 25-33 13l-110-110c-11-11-29-11-41 0L226 433c-11 11-11 29 0 41L492 740z" />
</Grid>
<local:MyCard HorizontalAlignment="Center" VerticalAlignment="Center" Margin="40,0" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False"> <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="LoadMinecraft" HorizontalAlignment="Center" VerticalAlignment="Center" /> <local:MyLoading Text="正在获取版本列表" Margin="20,20,20,17" x:Name="LoadMinecraft" HorizontalAlignment="Center" VerticalAlignment="Center" />
<local:MyLoading Visibility="Collapsed" x:Name="LoadOptiFine" HasAnimation="False" /> <local:MyLoading Visibility="Collapsed" x:Name="LoadOptiFine" HasAnimation="False" />
@@ -205,3 +174,26 @@
</local:MyCard> </local:MyCard>
</Grid> </Grid>
</local:MyPageRight> </local:MyPageRight>
<!--
指不定能把这俩玩意儿提成新控件:
<Grid Height="40">
<local:SystemDropShadowChrome Margin="-9.5,-9,0.5,-0.5" Opacity="0.1" CornerRadius="20" Color="{DynamicResource ColorObject1}" />
<Border BorderThickness="0.001" Background="{DynamicResource ColorBrush3}" CornerRadius="20">
<StackPanel Orientation="Horizontal" Margin="13,0" SnapsToDevicePixels="False" UseLayoutRounding="False" IsHitTestVisible="False">
<Path Stretch="Uniform" Height="13" VerticalAlignment="Center" Fill="{DynamicResource ColorBrush8}" RenderTransformOrigin="0.5,0.5"
Data="M1097 584 250 584 562 896C591 925 591 972 562 1001 533 1030 487 1030 458 1001L21 565C6 550-0 531 0 511L0 511 0 511C-0 492 6 472 21 457L458 21C487-7 533-7 562 21 591 50 591 97 562 126L250 438 1097 438C1137 438 1170 471 1170 511 1170 551 1137 584 1097 584L1097 584Z" />
</StackPanel>
</Border>
</Grid>
<Grid Height="40" Grid.Column="2">
<local:SystemDropShadowChrome Margin="-9.5,-9,0.5,-0.5" Opacity="0.1" CornerRadius="20" Color="{DynamicResource ColorObject1}" />
<Border BorderThickness="0.001" Background="{DynamicResource ColorBrush3}" CornerRadius="20">
<StackPanel Orientation="Horizontal" Margin="20,0" SnapsToDevicePixels="False" UseLayoutRounding="False" IsHitTestVisible="False">
<Path Stretch="Uniform" Height="13" VerticalAlignment="Center" Fill="{DynamicResource ColorBrush8}" RenderTransformOrigin="0.5,0.5"
Data="M73 584L920 584 608 896C579 925 579 972 608 1001 637 1030 683 1030 712 1001L1149 565C1164 550 1170 531 1170 511 1170 492 1164 472 1149 457L712 21C683-7 637-7 608 21 579 50 579 97 608 126L920 438 73 438C33 438 0 471 0 511 0 551 33 584 73 584Z" />
<TextBlock VerticalAlignment="Center" Foreground="{DynamicResource ColorBrush8}" FontSize="15" Margin="10,0,-2,1" Text="开始下载" />
</StackPanel>
</Border>
</Grid>
-->
@@ -1,7 +1,8 @@
Public Class PageDownloadInstall Public Class PageDownloadInstall
Private Sub LoaderInit() Handles Me.Initialized Private Sub LoaderInit() Handles Me.Initialized
PageLoaderInit(LoadMinecraft, PanLoad, PanBack, Nothing, DlClientListLoader, AddressOf LoadMinecraft_OnFinish) DisabledPageAnimControls.Add(BtnStart)
PageLoaderInit(LoadMinecraft, PanLoad, PanAllBack, Nothing, DlClientListLoader, AddressOf LoadMinecraft_OnFinish)
End Sub End Sub
Private IsLoad As Boolean = False Private IsLoad As Boolean = False
@@ -40,6 +41,8 @@
If IsInSelectPage Then Exit Sub If IsInSelectPage Then Exit Sub
IsInSelectPage = True IsInSelectPage = True
PanInner.Margin = New Thickness(25, 10, 25, 40)
AutoSelectedFabricApi = False AutoSelectedFabricApi = False
AutoSelectedOptiFabric = False AutoSelectedOptiFabric = False
IsSelectNameEdited = False IsSelectNameEdited = False
@@ -49,7 +52,8 @@
PanBack.IsHitTestVisible = False PanBack.IsHitTestVisible = False
PanBack.ScrollToHome() PanBack.ScrollToHome()
CardMinecraft.IsSwaped = True DisabledPageAnimControls.Remove(BtnStart)
BtnStart.Show = True
CardOptiFine.IsSwaped = True CardOptiFine.IsSwaped = True
CardLiteLoader.IsSwaped = True CardLiteLoader.IsSwaped = True
CardForge.IsSwaped = True CardForge.IsSwaped = True
@@ -64,9 +68,11 @@
End If End If
'如果在选择页面按了刷新键,选择页的东西可能会由于动画被隐藏,但不会由于加载结束而再次显示,因此这里需要手动恢复 '如果在选择页面按了刷新键,选择页的东西可能会由于动画被隐藏,但不会由于加载结束而再次显示,因此这里需要手动恢复
For Each Card In GetAllAnimControls(PanSelect) For Each Control In GetAllAnimControls(PanSelect)
Card.Opacity = 1 Control.Opacity = 1
Card.RenderTransform = New TranslateTransform If Control.RenderTransform Is Nothing OrElse TypeOf Control.RenderTransform Is TranslateTransform Then
Control.RenderTransform = New TranslateTransform
End If
Next Next
'启动 Forge 加载 '启动 Forge 加载
@@ -81,8 +87,8 @@
DlOptiFabricLoader.Start() DlOptiFabricLoader.Start()
AniStart({ AniStart({
AaOpacity(PanMinecraft, -PanMinecraft.Opacity, 100, 10), AaOpacity(PanMinecraft, -PanMinecraft.Opacity, 90, 10),
AaTranslateX(PanMinecraft, -50 - CType(PanMinecraft.RenderTransform, TranslateTransform).X, 110, 10), AaTranslateX(PanMinecraft, -50 - CType(PanMinecraft.RenderTransform, TranslateTransform).X, 100, 10),
AaCode( AaCode(
Sub() Sub()
PanBack.ScrollToHome() PanBack.ScrollToHome()
@@ -96,8 +102,8 @@
OptiFabric_Loaded() OptiFabric_Loaded()
SelectReload() SelectReload()
End Sub, After:=True), End Sub, After:=True),
AaOpacity(PanSelect, 1 - PanSelect.Opacity, 250, 150), AaOpacity(PanSelect, 1 - PanSelect.Opacity, 90, 100),
AaTranslateX(PanSelect, -CType(PanSelect.RenderTransform, TranslateTransform).X, 500, 150, Ease:=New AniEaseOutBack(AniEasePower.Weak)), AaTranslateX(PanSelect, -CType(PanSelect.RenderTransform, TranslateTransform).X, 200, 100, Ease:=New AniEaseOutFluent(AniEasePower.ExtraStrong)),
AaCode( AaCode(
Sub() Sub()
PanMinecraft.Visibility = Visibility.Collapsed PanMinecraft.Visibility = Visibility.Collapsed
@@ -115,10 +121,14 @@
End Sub,, True) End Sub,, True)
}, "FrmDownloadInstall SelectPageSwitch", True) }, "FrmDownloadInstall SelectPageSwitch", True)
End Sub End Sub
Public Sub ExitSelectPage() Public Sub ExitSelectPage() Handles BtnBack.Click
If Not IsInSelectPage Then Exit Sub If Not IsInSelectPage Then Exit Sub
IsInSelectPage = False IsInSelectPage = False
PanInner.Margin = New Thickness(25, 10, 25, 25)
DisabledPageAnimControls.Add(BtnStart)
BtnStart.Show = False
SelectClear() '清除已选择项 SelectClear() '清除已选择项
PanMinecraft.Visibility = Visibility.Visible PanMinecraft.Visibility = Visibility.Visible
PanSelect.IsHitTestVisible = False PanSelect.IsHitTestVisible = False
@@ -130,26 +140,21 @@
AaOpacity(PanSelect, -PanSelect.Opacity, 90, 10), AaOpacity(PanSelect, -PanSelect.Opacity, 90, 10),
AaTranslateX(PanSelect, 50 - CType(PanSelect.RenderTransform, TranslateTransform).X, 100, 10), AaTranslateX(PanSelect, 50 - CType(PanSelect.RenderTransform, TranslateTransform).X, 100, 10),
AaCode(Sub() PanBack.ScrollToHome(), After:=True), AaCode(Sub() PanBack.ScrollToHome(), After:=True),
AaOpacity(PanMinecraft, 1 - PanMinecraft.Opacity, 150, 100), AaOpacity(PanMinecraft, 1 - PanMinecraft.Opacity, 90, 100),
AaTranslateX(PanMinecraft, -CType(PanMinecraft.RenderTransform, TranslateTransform).X, 400, 100, Ease:=New AniEaseOutBack(AniEasePower.Weak)), AaTranslateX(PanMinecraft, -CType(PanMinecraft.RenderTransform, TranslateTransform).X, 200, 100, Ease:=New AniEaseOutFluent(AniEasePower.ExtraStrong)),
AaCode(Sub() AaCode(
PanSelect.Visibility = Visibility.Collapsed Sub()
PanBack.IsHitTestVisible = True PanSelect.Visibility = Visibility.Collapsed
End Sub,, True) PanBack.IsHitTestVisible = True
End Sub,, True)
}, "FrmDownloadInstall SelectPageSwitch") }, "FrmDownloadInstall SelectPageSwitch")
End Sub End Sub
'页面切换触发
Public Sub MinecraftSelected(sender As MyListItem, e As MouseButtonEventArgs) Public Sub MinecraftSelected(sender As MyListItem, e As MouseButtonEventArgs)
SelectedMinecraftId = sender.Title SelectedMinecraftId = sender.Title
SelectedMinecraftJsonUrl = sender.Tag("url").ToString SelectedMinecraftJsonUrl = sender.Tag("url").ToString
SelectedMinecraftIcon = sender.Logo SelectedMinecraftIcon = sender.Logo
EnterSelectPage() EnterSelectPage()
End Sub End Sub
Private Sub CardMinecraft_PreviewSwap(sender As Object, e As RouteEventArgs) Handles CardMinecraft.PreviewSwap
ExitSelectPage()
e.Handled = True
End Sub
#End Region #End Region
@@ -309,12 +314,7 @@
IsReloading = True IsReloading = True
'主预览 '主预览
SelectNameUpdate() SelectNameUpdate()
ItemSelect.Title = TextSelectName.Text ImgLogo.Source = GetSelectLogo()
ItemSelect.Info = GetSelectInfo()
ItemSelect.Logo = GetSelectLogo()
'Minecraft
LabMinecraft.Text = SelectedMinecraftId
ImgMinecraft.Source = New MyBitmap(SelectedMinecraftIcon)
'OptiFine 'OptiFine
Dim OptiFineError As String = LoadOptiFineGetError() Dim OptiFineError As String = LoadOptiFineGetError()
CardOptiFine.MainSwap.Visibility = If(OptiFineError Is Nothing, Visibility.Visible, Visibility.Collapsed) CardOptiFine.MainSwap.Visibility = If(OptiFineError Is Nothing, Visibility.Visible, Visibility.Collapsed)
@@ -323,7 +323,7 @@
If SelectedOptiFine Is Nothing Then If SelectedOptiFine Is Nothing Then
BtnOptiFineClear.Visibility = Visibility.Collapsed BtnOptiFineClear.Visibility = Visibility.Collapsed
ImgOptiFine.Visibility = Visibility.Collapsed ImgOptiFine.Visibility = Visibility.Collapsed
LabOptiFine.Text = If(OptiFineError, "点击选择") LabOptiFine.Text = If(OptiFineError, "可以添加")
LabOptiFine.Foreground = ColorGray4 LabOptiFine.Foreground = ColorGray4
Else Else
BtnOptiFineClear.Visibility = Visibility.Visible BtnOptiFineClear.Visibility = Visibility.Visible
@@ -343,7 +343,7 @@
If SelectedLiteLoader Is Nothing Then If SelectedLiteLoader Is Nothing Then
BtnLiteLoaderClear.Visibility = Visibility.Collapsed BtnLiteLoaderClear.Visibility = Visibility.Collapsed
ImgLiteLoader.Visibility = Visibility.Collapsed ImgLiteLoader.Visibility = Visibility.Collapsed
LabLiteLoader.Text = If(LiteLoaderError, "点击选择") LabLiteLoader.Text = If(LiteLoaderError, "可以添加")
LabLiteLoader.Foreground = ColorGray4 LabLiteLoader.Foreground = ColorGray4
Else Else
BtnLiteLoaderClear.Visibility = Visibility.Visible BtnLiteLoaderClear.Visibility = Visibility.Visible
@@ -360,7 +360,7 @@
If SelectedForge Is Nothing Then If SelectedForge Is Nothing Then
BtnForgeClear.Visibility = Visibility.Collapsed BtnForgeClear.Visibility = Visibility.Collapsed
ImgForge.Visibility = Visibility.Collapsed ImgForge.Visibility = Visibility.Collapsed
LabForge.Text = If(ForgeError, "点击选择") LabForge.Text = If(ForgeError, "可以添加")
LabForge.Foreground = ColorGray4 LabForge.Foreground = ColorGray4
Else Else
BtnForgeClear.Visibility = Visibility.Visible BtnForgeClear.Visibility = Visibility.Visible
@@ -380,7 +380,7 @@
If SelectedNeoForge Is Nothing Then If SelectedNeoForge Is Nothing Then
BtnNeoForgeClear.Visibility = Visibility.Collapsed BtnNeoForgeClear.Visibility = Visibility.Collapsed
ImgNeoForge.Visibility = Visibility.Collapsed ImgNeoForge.Visibility = Visibility.Collapsed
LabNeoForge.Text = If(NeoForgeError, "点击选择") LabNeoForge.Text = If(NeoForgeError, "可以添加")
LabNeoForge.Foreground = ColorGray4 LabNeoForge.Foreground = ColorGray4
Else Else
BtnNeoForgeClear.Visibility = Visibility.Visible BtnNeoForgeClear.Visibility = Visibility.Visible
@@ -401,7 +401,7 @@
If SelectedFabric Is Nothing Then If SelectedFabric Is Nothing Then
BtnFabricClear.Visibility = Visibility.Collapsed BtnFabricClear.Visibility = Visibility.Collapsed
ImgFabric.Visibility = Visibility.Collapsed ImgFabric.Visibility = Visibility.Collapsed
LabFabric.Text = If(FabricError, "点击选择") LabFabric.Text = If(FabricError, "可以添加")
LabFabric.Foreground = ColorGray4 LabFabric.Foreground = ColorGray4
Else Else
BtnFabricClear.Visibility = Visibility.Visible BtnFabricClear.Visibility = Visibility.Visible
@@ -422,7 +422,7 @@
If SelectedFabricApi Is Nothing Then If SelectedFabricApi Is Nothing Then
BtnFabricApiClear.Visibility = Visibility.Collapsed BtnFabricApiClear.Visibility = Visibility.Collapsed
ImgFabricApi.Visibility = Visibility.Collapsed ImgFabricApi.Visibility = Visibility.Collapsed
LabFabricApi.Text = If(FabricApiError, "点击选择") LabFabricApi.Text = If(FabricApiError, "可以添加")
LabFabricApi.Foreground = ColorGray4 LabFabricApi.Foreground = ColorGray4
Else Else
BtnFabricApiClear.Visibility = Visibility.Visible BtnFabricApiClear.Visibility = Visibility.Visible
@@ -443,7 +443,7 @@
If SelectedOptiFabric Is Nothing Then If SelectedOptiFabric Is Nothing Then
BtnOptiFabricClear.Visibility = Visibility.Collapsed BtnOptiFabricClear.Visibility = Visibility.Collapsed
ImgOptiFabric.Visibility = Visibility.Collapsed ImgOptiFabric.Visibility = Visibility.Collapsed
LabOptiFabric.Text = If(OptiFabricError, "点击选择") LabOptiFabric.Text = If(OptiFabricError, "可以添加")
LabOptiFabric.Foreground = ColorGray4 LabOptiFabric.Foreground = ColorGray4
Else Else
BtnOptiFabricClear.Visibility = Visibility.Visible BtnOptiFabricClear.Visibility = Visibility.Visible
@@ -495,7 +495,26 @@
SelectedOptiFabric = Nothing SelectedOptiFabric = Nothing
End Sub End Sub
'显示信息获取 ''' <summary>
''' 获取版本图标。
''' </summary>
Private Function GetSelectLogo() As String
If SelectedFabric IsNot Nothing Then
Return "pack://application:,,,/images/Blocks/Fabric.png"
ElseIf SelectedForge IsNot Nothing Then
Return "pack://application:,,,/images/Blocks/Anvil.png"
ElseIf SelectedNeoForge IsNot Nothing Then
Return "pack://application:,,,/images/Blocks/NeoForge.png"
ElseIf SelectedLiteLoader IsNot Nothing Then
Return "pack://application:,,,/images/Blocks/Egg.png"
ElseIf SelectedOptiFine IsNot Nothing Then
Return "pack://application:,,,/images/Blocks/GrassPath.png"
Else
Return SelectedMinecraftIcon
End If
End Function
'版本名处理
''' <summary> ''' <summary>
''' 获取默认版本名。 ''' 获取默认版本名。
''' </summary> ''' </summary>
@@ -518,49 +537,6 @@
End If End If
Return Name Return Name
End Function End Function
''' <summary>
''' 获取版本描述信息。
''' </summary>
Private Function GetSelectInfo() As String
Dim Info As String = ""
If SelectedFabric IsNot Nothing Then
Info += ", Fabric " & SelectedFabric.Replace("+build", "")
End If
If SelectedForge IsNot Nothing Then
Info += ", Forge " & SelectedForge.VersionName
End If
If SelectedNeoForge IsNot Nothing Then
Info += ", NeoForge " & SelectedNeoForge.VersionName
End If
If SelectedLiteLoader IsNot Nothing Then
Info += ", LiteLoader"
End If
If SelectedOptiFine IsNot Nothing Then
Info += ", OptiFine " & SelectedOptiFine.NameDisplay.Replace(SelectedMinecraftId & " ", "")
End If
If Info = "" Then Info = ", 无附加安装"
Return Info.TrimStart(", ".ToCharArray())
End Function
''' <summary>
''' 获取版本图标。
''' </summary>
Private Function GetSelectLogo() As String
If SelectedFabric IsNot Nothing Then
Return "pack://application:,,,/images/Blocks/Fabric.png"
ElseIf SelectedForge IsNot Nothing Then
Return "pack://application:,,,/images/Blocks/Anvil.png"
ElseIf SelectedNeoForge IsNot Nothing Then
Return "pack://application:,,,/images/Blocks/NeoForge.png"
ElseIf SelectedLiteLoader IsNot Nothing Then
Return "pack://application:,,,/images/Blocks/Egg.png"
ElseIf SelectedOptiFine IsNot Nothing Then
Return "pack://application:,,,/images/Blocks/GrassPath.png"
Else
Return SelectedMinecraftIcon
End If
End Function
'版本名处理
Private IsSelectNameEdited As Boolean = False Private IsSelectNameEdited As Boolean = False
Private IsSelectNameChanging As Boolean = False Private IsSelectNameChanging As Boolean = False
Private Sub SelectNameUpdate() Private Sub SelectNameUpdate()
@@ -575,7 +551,7 @@
SelectReload() SelectReload()
End Sub End Sub
Private Sub TextSelectName_ValidateChanged(sender As Object, e As EventArgs) Handles TextSelectName.ValidateChanged Private Sub TextSelectName_ValidateChanged(sender As Object, e As EventArgs) Handles TextSelectName.ValidateChanged
BtnSelectStart.IsEnabled = TextSelectName.ValidateResult = "" BtnStart.IsEnabled = TextSelectName.IsValidated
End Sub End Sub
#End Region #End Region
@@ -614,7 +590,7 @@
Version("id") = "20w14∞" Version("id") = "20w14∞"
Version("type") = "special" Version("type") = "special"
Version.Add("lore", GetMcFoolName(Version("id"))) Version.Add("lore", GetMcFoolName(Version("id")))
Case "3d shareware v1.34", "1.rv-pre1", "15w14a", "2.0", "22w13oneblockatatime", "23w13a_or_b", "24w14potato" Case "3d shareware v1.34", "1.rv-pre1", "15w14a", "2.0", "22w13oneblockatatime", "23w13a_or_b", "24w14potato", "25w14craftmine"
Type = "愚人节版" Type = "愚人节版"
Version("type") = "special" Version("type") = "special"
Version.Add("lore", GetMcFoolName(Version("id"))) Version.Add("lore", GetMcFoolName(Version("id")))
@@ -635,10 +611,8 @@
Dict(Type).Add(Version) Dict(Type).Add(Version)
Next Next
'排序 '排序
For i = 0 To Dict.Keys.Count - 1 For Each Pair In Dict.ToList
Dict(Dict.Keys(i)) = Sort(Dict.Values(i), Function(Left As JObject, Right As JObject) As Boolean Dict(Pair.Key) = Pair.Value.OrderByDescending(Function(j) j("releaseTime").Value(Of Date)).ToList
Return Left("releaseTime").Value(Of Date) > Right("releaseTime").Value(Of Date)
End Function)
Next Next
'清空当前 '清空当前
PanMinecraft.Children.Clear() PanMinecraft.Children.Clear()
@@ -695,46 +669,41 @@
''' </summary> ''' </summary>
Private Function LoadOptiFineGetError() As String Private Function LoadOptiFineGetError() As String
If SelectedNeoForge IsNot Nothing Then Return "与 NeoForge 不兼容" If SelectedNeoForge IsNot Nothing Then Return "与 NeoForge 不兼容"
If LoadOptiFine Is Nothing OrElse LoadOptiFine.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……" If LoadOptiFine Is Nothing OrElse LoadOptiFine.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "加载中……"
If LoadOptiFine.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadOptiFine.State, Object).Error.Message If LoadOptiFine.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadOptiFine.State, Object).Error.Message
'检查 Forge 1.13 - 1.14.3:全部不兼容 '检查 Forge 1.13 - 1.14.3:全部不兼容
If SelectedForge IsNot Nothing AndAlso If SelectedForge IsNot Nothing AndAlso
VersionSortInteger(SelectedMinecraftId, "1.13") >= 0 AndAlso VersionSortInteger("1.14.3", SelectedMinecraftId) >= 0 Then VersionSortInteger(SelectedMinecraftId, "1.13") >= 0 AndAlso VersionSortInteger("1.14.3", SelectedMinecraftId) >= 0 Then
Return "与 Forge 不兼容" Return "与 Forge 不兼容"
End If End If
'检查最低 Forge 版本 '检查 Forge 版本
Dim MinimalForgeVersion As String = "9999.9999" Dim HasAny As Boolean = False
Dim NotSuitForForge As Boolean = False Dim HasRequiredVersion As Boolean = False
For Each OptiFineVersion As DlOptiFineListEntry In DlOptiFineListLoader.Output.Value For Each OptiFineVersion As DlOptiFineListEntry In DlOptiFineListLoader.Output.Value
If Not OptiFineVersion.NameDisplay.StartsWith(SelectedMinecraftId & " ") Then Continue For '不是同一个大版本 If Not OptiFineVersion.NameDisplay.StartsWith(SelectedMinecraftId & " ") Then Continue For '不是同一个大版本
If SelectedForge Is Nothing Then Return Nothing '该版本可用 HasAny = True
If IsOptiFineSuitForForge(OptiFineVersion, SelectedForge) Then If SelectedForge Is Nothing Then Return Nothing '未选择 Forge
Return Nothing '该版本可用 If IsOptiFineSuitForForge(OptiFineVersion, SelectedForge) Then Return Nothing '该版本可用
Else If OptiFineVersion.RequiredForgeVersion IsNot Nothing Then HasRequiredVersion = True
NotSuitForForge = True
If OptiFineVersion.RequiredForgeVersion IsNot Nothing Then
'设置用于显示的最低允许的 Forge 版本
MinimalForgeVersion = If(VersionSortBoolean(MinimalForgeVersion, OptiFineVersion.RequiredForgeVersion),
OptiFineVersion.RequiredForgeVersion, MinimalForgeVersion)
End If
End If
Next Next
If MinimalForgeVersion = "9999.9999" Then If Not HasAny Then
Return If(NotSuitForForge, "与 Forge 不兼容", "没有可用版本") Return "不可用"
ElseIf HasRequiredVersion Then
Return "仅兼容特定版本的 Forge"
Else Else
Return "需要 Forge " & If(MinimalForgeVersion.Contains("."), "", "#") & MinimalForgeVersion & " 或更高版本" Return "与 Forge 不兼容"
End If End If
End Function End Function
'检查某个 OptiFine 是否与某个 Forge 兼容(最低 Forge 版本是否达到需求) '检查某个 OptiFine 是否与某个 Forge 兼容
Private Function IsOptiFineSuitForForge(OptiFine As DlOptiFineListEntry, Forge As DlForgeVersionEntry) Private Function IsOptiFineSuitForForge(OptiFine As DlOptiFineListEntry, Forge As DlForgeVersionEntry)
If Forge.Inherit <> OptiFine.Inherit Then Return False '不是同一个大版本 If Forge.Inherit <> OptiFine.Inherit Then Return False '不是同一个大版本
If OptiFine.RequiredForgeVersion Is Nothing Then Return False '不兼容 Forge If OptiFine.RequiredForgeVersion Is Nothing Then Return False '不兼容 Forge
If String.IsNullOrWhiteSpace(OptiFine.RequiredForgeVersion) Then Return True '#4183 If String.IsNullOrWhiteSpace(OptiFine.RequiredForgeVersion) Then Return True '#4183
If OptiFine.RequiredForgeVersion.Contains(".") Then 'XX.X.XXX If OptiFine.RequiredForgeVersion.Contains(".") Then 'XX.X.XXX
Return VersionSortInteger(Forge.Version.ToString, OptiFine.RequiredForgeVersion) >= 0 Return VersionSortInteger(Forge.Version.ToString, OptiFine.RequiredForgeVersion) = 0
Else 'XXXX Else 'XXXX
Return Forge.Version.Revision >= OptiFine.RequiredForgeVersion Return Forge.Version.Revision = OptiFine.RequiredForgeVersion
End If End If
End Function End Function
@@ -758,7 +727,7 @@
Next Next
If Not Versions.Any() Then Exit Sub If Not Versions.Any() Then Exit Sub
'排序 '排序
Versions = Sort(Versions, Versions = Versions.Sort(
Function(Left As DlOptiFineListEntry, Right As DlOptiFineListEntry) As Boolean Function(Left As DlOptiFineListEntry, Right As DlOptiFineListEntry) As Boolean
If Not Left.IsPreview AndAlso Right.IsPreview Then Return True If Not Left.IsPreview AndAlso Right.IsPreview Then Return True
If Left.IsPreview AndAlso Not Right.IsPreview Then Return False If Left.IsPreview AndAlso Not Right.IsPreview Then Return False
@@ -787,6 +756,7 @@
Private Sub OptiFine_Clear(sender As Object, e As MouseButtonEventArgs) Handles BtnOptiFineClear.MouseLeftButtonUp Private Sub OptiFine_Clear(sender As Object, e As MouseButtonEventArgs) Handles BtnOptiFineClear.MouseLeftButtonUp
SelectedOptiFine = Nothing SelectedOptiFine = Nothing
SelectedOptiFabric = Nothing SelectedOptiFabric = Nothing
AutoSelectedOptiFabric = False
CardOptiFine.IsSwaped = True CardOptiFine.IsSwaped = True
e.Handled = True e.Handled = True
Forge_Loaded() Forge_Loaded()
@@ -802,13 +772,13 @@
''' 获取 LiteLoader 的加载异常信息。若正常则返回 Nothing。 ''' 获取 LiteLoader 的加载异常信息。若正常则返回 Nothing。
''' </summary> ''' </summary>
Private Function LoadLiteLoaderGetError() As String Private Function LoadLiteLoaderGetError() As String
If Not SelectedMinecraftId.Contains("1.") OrElse Val(SelectedMinecraftId.Split(".")(1)) > 12 Then Return "没有可用版本" If Not SelectedMinecraftId.Contains("1.") OrElse Val(SelectedMinecraftId.Split(".")(1)) > 12 Then Return "不可用"
If LoadLiteLoader Is Nothing OrElse LoadLiteLoader.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……" If LoadLiteLoader Is Nothing OrElse LoadLiteLoader.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "加载中……"
If LoadLiteLoader.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadLiteLoader.State, Object).Error.Message If LoadLiteLoader.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadLiteLoader.State, Object).Error.Message
For Each Version As DlLiteLoaderListEntry In DlLiteLoaderListLoader.Output.Value For Each Version As DlLiteLoaderListEntry In DlLiteLoaderListLoader.Output.Value
If Version.Inherit = SelectedMinecraftId Then Return Nothing If Version.Inherit = SelectedMinecraftId Then Return Nothing
Next Next
Return "没有可用版本" Return "不可用"
End Function End Function
'限制展开 '限制展开
@@ -859,15 +829,15 @@
''' 获取 Forge 的加载异常信息。若正常则返回 Nothing。 ''' 获取 Forge 的加载异常信息。若正常则返回 Nothing。
''' </summary> ''' </summary>
Private Function LoadForgeGetError() As String Private Function LoadForgeGetError() As String
If Not SelectedMinecraftId.StartsWith("1.") Then Return "没有可用版本" If Not SelectedMinecraftId.StartsWith("1.") Then Return "不可用"
If Not LoadForge.State.IsLoader Then Return "正在获取版本列表……" If Not LoadForge.State.IsLoader Then Return "加载中……"
Dim Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)) = LoadForge.State Dim Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)) = LoadForge.State
If SelectedMinecraftId <> Loader.Input Then Return "正在获取版本列表……" If SelectedMinecraftId <> Loader.Input Then Return "加载中……"
If Loader.State = LoadState.Loading Then Return "正在获取版本列表……" If Loader.State = LoadState.Loading Then Return "加载中……"
If Loader.State = LoadState.Failed Then If Loader.State = LoadState.Failed Then
Dim ErrorMessage As String = Loader.Error.Message Dim ErrorMessage As String = Loader.Error.Message
If ErrorMessage.Contains("没有可用版本") Then If ErrorMessage.Contains("不可用") Then
Return "没有可用版本" Return "不可用"
Else Else
Return "获取版本列表失败:" & ErrorMessage Return "获取版本列表失败:" & ErrorMessage
End If End If
@@ -909,12 +879,12 @@
Dim Versions = Loader.Output.ToList '复制数组,以免 Output 在实例化后变空 Dim Versions = Loader.Output.ToList '复制数组,以免 Output 在实例化后变空
If Not Loader.Output.Any() Then Exit Sub If Not Loader.Output.Any() Then Exit Sub
PanForge.Children.Clear() PanForge.Children.Clear()
Versions = Sort(Versions, Function(a, b) a.Version > b.Version).Where( Versions = Versions.Where(
Function(v) Function(v)
If v.Category = "universal" OrElse v.Category = "client" Then Return False '跳过无法自动安装的版本 If v.Category = "universal" OrElse v.Category = "client" Then Return False '跳过无法自动安装的版本
If SelectedOptiFine IsNot Nothing AndAlso Not IsOptiFineSuitForForge(SelectedOptiFine, v) Then Return False If SelectedOptiFine IsNot Nothing AndAlso Not IsOptiFineSuitForForge(SelectedOptiFine, v) Then Return False
Return True Return True
End Function).ToList() End Function).OrderByDescending(Function(v) v.Version).ToList()
ForgeDownloadListItemPreload(PanForge, Versions, AddressOf Forge_Selected, False) ForgeDownloadListItemPreload(PanForge, Versions, AddressOf Forge_Selected, False)
For Each Version In Versions For Each Version In Versions
PanForge.Children.Add(ForgeDownloadListItem(Version, AddressOf Forge_Selected, False)) PanForge.Children.Add(ForgeDownloadListItem(Version, AddressOf Forge_Selected, False))
@@ -948,16 +918,16 @@
''' 获取 NeoForge 的加载异常信息。若正常则返回 Nothing。 ''' 获取 NeoForge 的加载异常信息。若正常则返回 Nothing。
''' </summary> ''' </summary>
Private Function LoadNeoForgeGetError() As String Private Function LoadNeoForgeGetError() As String
If Not SelectedMinecraftId.StartsWith("1.") Then Return "没有可用版本" If Not SelectedMinecraftId.StartsWith("1.") Then Return "不可用"
If SelectedOptiFine IsNot Nothing Then Return "与 OptiFine 不兼容" If SelectedOptiFine IsNot Nothing Then Return "与 OptiFine 不兼容"
If SelectedForge IsNot Nothing Then Return "与 Forge 不兼容" If SelectedForge IsNot Nothing Then Return "与 Forge 不兼容"
If SelectedFabric IsNot Nothing Then Return "与 Fabric 不兼容" If SelectedFabric IsNot Nothing Then Return "与 Fabric 不兼容"
If LoadNeoForge Is Nothing OrElse LoadNeoForge.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……" If LoadNeoForge Is Nothing OrElse LoadNeoForge.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "加载中……"
If LoadNeoForge.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadNeoForge.State, Object).Error.Message If LoadNeoForge.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadNeoForge.State, Object).Error.Message
If DlNeoForgeListLoader.Output.Value.Any(Function(v) v.Inherit = SelectedMinecraftId) Then If DlNeoForgeListLoader.Output.Value.Any(Function(v) v.Inherit = SelectedMinecraftId) Then
Return Nothing Return Nothing
Else Else
Return "没有可用版本" Return "不可用"
End If End If
End Function End Function
@@ -1009,7 +979,7 @@
''' 获取 Fabric 的加载异常信息。若正常则返回 Nothing。 ''' 获取 Fabric 的加载异常信息。若正常则返回 Nothing。
''' </summary> ''' </summary>
Private Function LoadFabricGetError() As String Private Function LoadFabricGetError() As String
If LoadFabric Is Nothing OrElse LoadFabric.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……" If LoadFabric Is Nothing OrElse LoadFabric.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "加载中……"
If LoadFabric.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadFabric.State, Object).Error.Message If LoadFabric.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadFabric.State, Object).Error.Message
For Each Version As JObject In DlFabricListLoader.Output.Value("game") For Each Version As JObject In DlFabricListLoader.Output.Value("game")
If Version("version").ToString = SelectedMinecraftId.Replace("∞", "infinite").Replace("Combat Test 7c", "1.16_combat-3") Then If Version("version").ToString = SelectedMinecraftId.Replace("∞", "infinite").Replace("Combat Test 7c", "1.16_combat-3") Then
@@ -1018,7 +988,7 @@
Return Nothing Return Nothing
End If End If
Next Next
Return "没有可用版本" Return "不可用"
End Function End Function
'限制展开 '限制展开
@@ -1056,7 +1026,9 @@
Private Sub Fabric_Clear(sender As Object, e As MouseButtonEventArgs) Handles BtnFabricClear.MouseLeftButtonUp Private Sub Fabric_Clear(sender As Object, e As MouseButtonEventArgs) Handles BtnFabricClear.MouseLeftButtonUp
SelectedFabric = Nothing SelectedFabric = Nothing
SelectedFabricApi = Nothing SelectedFabricApi = Nothing
AutoSelectedFabricApi = False
SelectedOptiFabric = Nothing SelectedOptiFabric = Nothing
AutoSelectedOptiFabric = False
CardFabric.IsSwaped = True CardFabric.IsSwaped = True
e.Handled = True e.Handled = True
SelectReload() SelectReload()
@@ -1076,12 +1048,12 @@
If DisplayName.StartsWith("[" & MinecraftVersion & "]") Then Return True If DisplayName.StartsWith("[" & MinecraftVersion & "]") Then Return True
If Not DisplayName.Contains("/") OrElse Not DisplayName.Contains("]") Then Return False If Not DisplayName.Contains("/") OrElse Not DisplayName.Contains("]") Then Return False
'直接的判断(例如 1.18.1/22w03a) '直接的判断(例如 1.18.1/22w03a)
For Each Part As String In DisplayName.Before("]").TrimStart("[").Split("/") For Each Part As String In DisplayName.BeforeFirst("]").TrimStart("[").Split("/")
If Part = MinecraftVersion Then Return True If Part = MinecraftVersion Then Return True
Next Next
'将版本名分割语素(例如 1.16.4/5) '将版本名分割语素(例如 1.16.4/5)
Dim Lefts = RegexSearch(DisplayName.Before("]"), "[a-z/]+|[0-9/]+") Dim Lefts = RegexSearch(DisplayName.BeforeFirst("]"), "[a-z/]+|[0-9/]+")
Dim Rights = RegexSearch(MinecraftVersion.Before("]"), "[a-z/]+|[0-9/]+") Dim Rights = RegexSearch(MinecraftVersion.BeforeFirst("]"), "[a-z/]+|[0-9/]+")
'对每段进行判断 '对每段进行判断
Dim i As Integer = 0 Dim i As Integer = 0
While True While True
@@ -1109,18 +1081,18 @@
''' 获取 FabricApi 的加载异常信息。若正常则返回 Nothing。 ''' 获取 FabricApi 的加载异常信息。若正常则返回 Nothing。
''' </summary> ''' </summary>
Private Function LoadFabricApiGetError() As String Private Function LoadFabricApiGetError() As String
If LoadFabricApi Is Nothing OrElse LoadFabricApi.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……" If LoadFabricApi Is Nothing OrElse LoadFabricApi.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "加载中……"
If LoadFabricApi.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadFabricApi.State, Object).Error.Message If LoadFabricApi.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadFabricApi.State, Object).Error.Message
If DlFabricApiLoader.Output Is Nothing Then If DlFabricApiLoader.Output Is Nothing Then
If SelectedFabric Is Nothing Then Return "需要安装 Fabric" If SelectedFabric Is Nothing Then Return "需要安装 Fabric"
Return "正在获取版本列表……" Return "加载中……"
End If End If
For Each Version In DlFabricApiLoader.Output For Each Version In DlFabricApiLoader.Output
If Not IsSuitableFabricApi(Version.DisplayName, SelectedMinecraftId) Then Continue For If Not IsSuitableFabricApi(Version.DisplayName, SelectedMinecraftId) Then Continue For
If SelectedFabric Is Nothing Then Return "需要安装 Fabric" If SelectedFabric Is Nothing Then Return "需要安装 Fabric"
Return Nothing Return Nothing
Next Next
Return "没有可用版本" Return "不可用"
End Function End Function
'限制展开 '限制展开
@@ -1148,7 +1120,7 @@
End If End If
Next Next
If Not Versions.Any() Then Exit Sub If Not Versions.Any() Then Exit Sub
Versions = Sort(Versions, Function(a, b) a.ReleaseDate > b.ReleaseDate) Versions = Versions.OrderByDescending(Function(v) v.ReleaseDate).ToList
'可视化 '可视化
PanFabricApi.Children.Clear() PanFabricApi.Children.Clear()
For Each Version In Versions For Each Version In Versions
@@ -1202,13 +1174,13 @@
''' </summary> ''' </summary>
Private Function LoadOptiFabricGetError() As String Private Function LoadOptiFabricGetError() As String
If SelectedMinecraftId.StartsWith("1.14") OrElse SelectedMinecraftId.StartsWith("1.15") Then Return "不兼容老版本 Fabric,请手动下载 OptiFabric Origins" If SelectedMinecraftId.StartsWith("1.14") OrElse SelectedMinecraftId.StartsWith("1.15") Then Return "不兼容老版本 Fabric,请手动下载 OptiFabric Origins"
If LoadOptiFabric Is Nothing OrElse LoadOptiFabric.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……" If LoadOptiFabric Is Nothing OrElse LoadOptiFabric.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "加载中……"
If LoadOptiFabric.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadOptiFabric.State, Object).Error.Message If LoadOptiFabric.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败:" & CType(LoadOptiFabric.State, Object).Error.Message
If DlOptiFabricLoader.Output Is Nothing Then If DlOptiFabricLoader.Output Is Nothing Then
If SelectedFabric Is Nothing AndAlso SelectedOptiFine Is Nothing Then Return "需要安装 OptiFine 与 Fabric" If SelectedFabric Is Nothing AndAlso SelectedOptiFine Is Nothing Then Return "需要安装 OptiFine 与 Fabric"
If SelectedFabric Is Nothing Then Return "需要安装 Fabric" If SelectedFabric Is Nothing Then Return "需要安装 Fabric"
If SelectedOptiFine Is Nothing Then Return "需要安装 OptiFine" If SelectedOptiFine Is Nothing Then Return "需要安装 OptiFine"
Return "正在获取版本列表……" Return "加载中……"
End If End If
For Each Version In DlOptiFabricLoader.Output For Each Version In DlOptiFabricLoader.Output
If Not IsSuitableOptiFabric(Version, SelectedMinecraftId) Then Continue For '2135# If Not IsSuitableOptiFabric(Version, SelectedMinecraftId) Then Continue For '2135#
@@ -1217,7 +1189,7 @@
If SelectedOptiFine Is Nothing Then Return "需要安装 OptiFine" If SelectedOptiFine Is Nothing Then Return "需要安装 OptiFine"
Return Nothing '通过检查 Return Nothing '通过检查
Next Next
Return "没有可用版本" Return "不可用"
End Function End Function
'限制展开 '限制展开
@@ -1239,7 +1211,7 @@
Next Next
If Not Versions.Any() Then Exit Sub If Not Versions.Any() Then Exit Sub
'排序 '排序
Versions = Sort(Versions, Function(a, b) a.ReleaseDate > b.ReleaseDate) Versions = Versions.OrderByDescending(Function(v) v.ReleaseDate).ToList
'可视化 '可视化
PanOptiFabric.Children.Clear() PanOptiFabric.Children.Clear()
For Each Version In Versions For Each Version In Versions
@@ -1276,22 +1248,23 @@
#Region "安装" #Region "安装"
Private Sub TextSelectName_KeyDown(sender As Object, e As KeyEventArgs) Handles TextSelectName.KeyDown Private Sub TextSelectName_KeyDown(sender As Object, e As KeyEventArgs) Handles TextSelectName.KeyDown
If e.Key = Key.Enter AndAlso BtnSelectStart.IsEnabled Then BtnSelectStart_Click() If e.Key = Key.Enter AndAlso BtnStart.IsEnabled Then BtnStart_Click()
End Sub End Sub
Private Sub BtnSelectStart_Click() Handles BtnSelectStart.Click Private Sub BtnStart_Click() Handles BtnStart.Click
'确认版本隔离 '确认版本隔离
If (SelectedForge IsNot Nothing OrElse SelectedNeoForge IsNot Nothing OrElse SelectedFabric IsNot Nothing) AndAlso If (SelectedForge IsNot Nothing OrElse SelectedNeoForge IsNot Nothing OrElse SelectedFabric IsNot Nothing) AndAlso
(Setup.Get("LaunchArgumentIndie") = 0 OrElse Setup.Get("LaunchArgumentIndie") = 2) Then (Setup.Get("LaunchArgumentIndieV2") = 0 OrElse Setup.Get("LaunchArgumentIndieV2") = 2) Then
If MyMsgBox("你尚未开启版本隔离,这会导致多个 MC 共用同一个 Mod 文件夹。" & vbCrLf & If MyMsgBox("你尚未开启版本隔离,这会导致多个版本共用同一个 Mod 文件夹。" & vbCrLf &
"因此在切换 MC 版本时,MC 会因为读取到与当前版本不符的 Mod 而崩溃。" & vbCrLf & "因此游戏可能会因为读取到与当前版本不符的 Mod 而崩溃。" & vbCrLf &
"PCL 推荐你在开始下载前,在 设置 → 版本隔离 中开启版本隔离选项!", "版本隔离提示", "取消下载", "继续") = 1 Then "推荐在开始下载前,在 设置 → 启动选项 → 版本隔离 中开启版本隔离!", "版本隔离提示", "取消下载", "继续") = 1 Then
Exit Sub Exit Sub
End If End If
End If End If
'提交安装申请 '提交安装申请
Dim VersionName As String = TextSelectName.Text
Dim Request As New McInstallRequest With { Dim Request As New McInstallRequest With {
.TargetVersionName = TextSelectName.Text, .TargetVersionName = VersionName,
.TargetVersionFolder = $"{PathMcFolder}versions\{TextSelectName.Text}\", .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
.MinecraftJson = SelectedMinecraftJsonUrl, .MinecraftJson = SelectedMinecraftJsonUrl,
.MinecraftName = SelectedMinecraftId, .MinecraftName = SelectedMinecraftId,
.OptiFineEntry = SelectedOptiFine, .OptiFineEntry = SelectedOptiFine,
@@ -2,73 +2,74 @@
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="{Binding ElementName=PanItem, Mode=OneWay}">
<StackPanel Margin="0,12,0,0" Name="PanItem"> <local:MyScrollViewer PanningMode="VerticalOnly" HorizontalScrollBarVisibility="Disabled" VerticalScrollBarVisibility="Auto" Style="{StaticResource ScrollViewerFullMargin}">
<StackPanel Margin="0,12,0,0" Name="PanItem">
<TextBlock x:Name="LabGame" Text="Minecraft" Margin="13,6,5,4" Opacity="0.6" FontSize="12" /> <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="1" 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="游戏下载"
LogoScale="0.87" Logo="M1091.291429 0H78.935771C35.34848 0.035109 0.029257 35.354331 0 78.935771v863.331475c0 43.534629 35.401143 78.994286 78.935771 78.994285H1091.291429c43.534629 0 78.994286-35.401143 78.994285-78.994285V78.871406C1170.156983 35.319223 1134.849463 0.064366 1091.291429 0z m-8.835658 87.771429v78.754377H87.771429v-78.760229h994.684342zM87.771429 933.425737V254.232869h994.684342v679.140205H87.771429v0.058515zM724.95104 340.00896l-206.19264 547.605943a43.903269 43.903269 0 0 1-82.154057-31.012572l206.139977-547.547428a43.944229 43.944229 0 0 1 82.20672 30.954057zM369.558674 545.909029l-85.489371 85.489371 85.489371 85.542034a43.885714 43.885714 0 0 1-62.025143 62.083657l-116.554605-116.560457a43.8272 43.8272 0 0 1 0-62.025143l116.560457-116.49024a43.885714 43.885714 0 0 1 62.019291 61.966629z m610.567315-37.566172a43.885714 43.885714 0 0 1 0 62.083657l-116.560458 116.560457a43.768686 43.768686 0 0 1-62.019291 0 43.885714 43.885714 0 0 1 0-62.083657l85.547886-85.547885-85.547886-85.542035a43.897417 43.897417 0 0 1 62.083657-62.083657l116.496092 116.618972z"> 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="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" />
</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="手动安装包" <local:MyListItem x:Name="ItemHand" IsScaleAnimationEnabled="False" Type="RadioBox" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="手动安装包"
LogoScale="1.02" Logo="M292.693 787.627c0 30.72-24.746 55.466-55.466 55.466s-55.467-24.746-55.467-55.466 24.747-55.467 55.467-55.467c30.72-0.853 55.466 24.747 55.466 55.467z M1000.96 241.493c-2.56-5.973-4.267-11.946-6.827-17.92-0.853-6.826-4.266-12.8-8.533-17.92-7.68-9.386-18.773-15.36-31.573-15.36-6.827 0-13.654 1.707-19.627 5.12l-15.36 15.36-17.067 17.067-21.333 21.333L749.227 381.44c-14.507 14.507-38.4 14.507-52.907 0l-54.613-54.613c-14.507-14.507-14.507-38.4 0-52.907l132.266-132.267 14.507-14.506 20.48-20.48 16.213-16.214c3.414-5.973 5.12-11.946 5.12-19.626 0-12.8-5.973-24.747-16.213-32.427-5.973-4.267-11.947-6.827-18.773-7.68-5.12-2.56-10.24-4.267-16.214-5.973-36.693-12.8-76.8-19.627-117.76-19.627-7.68 0-14.506 0-22.186 0.853-188.587 11.947-337.92 168.107-337.92 360.96 0 16.214 0.853 32.427 3.413 48.64L56.32 663.04c-73.387 74.24-73.387 193.707 0 267.093l33.28 33.28c73.387 73.387 193.707 73.387 267.093 0l240.64-241.493c21.334 4.267 42.667 5.973 64 5.973 190.294 0 346.454-146.773 360.107-333.653 0.853-8.533 0.853-17.92 0.853-27.307 0.854-44.373-6.826-86.186-21.333-125.44zM658.773 639.147c-28.16 0-54.613-4.267-79.36-11.094-4.266 7.68-10.24 14.507-16.213 21.334l-258.56 258.56c-43.52 43.52-115.2 43.52-158.72 0l-29.013-29.014c-43.52-44.373-43.52-115.2 0-158.72l212.48-212.48 46.08-46.08c5.973-5.973 12.8-11.093 19.626-15.36-8.533-26.453-12.8-54.613-12.8-83.626v-1.707c0-152.747 123.734-275.627 276.48-275.627 18.774 0 37.547 1.707 55.467 5.974L597.333 207.36c-52.053 52.053-52.053 137.387 0 189.44l29.867 29.867c52.053 52.053 137.387 52.053 189.44 0L930.987 312.32c2.56 16.213 4.266 33.28 4.266 50.347 0 152.746-123.733 276.48-276.48 276.48z" /> 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" />
<TextBlock x:Name="LabHand" Visibility="Collapsed" Text="▼ 手动安装包" Padding="11,18,5,4" Opacity="0.6" FontSize="12" /> <TextBlock x:Name="LabHand" Visibility="Collapsed" Text="▼ 手动安装包" Padding="11,18,5,4" Opacity="0.6" FontSize="12" />
<local:MyListItem x:Name="ItemClient" Visibility="Collapsed" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="4" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="Minecraft" <local:MyListItem x:Name="ItemClient" Visibility="Collapsed" IsScaleAnimationEnabled="False" Type="RadioBox" Tag="4" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="Minecraft"
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"> 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">
<!--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">--> <!--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: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="ItemOptiFine" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="5" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="OptiFine"
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="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">
<!--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">-->
<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="ItemForge" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="6" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="Forge"
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.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">
<!--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">--> <!--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" <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"> 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> <local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}"> <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" /> <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> </x:Array>
</local:MyListItem.Buttons> </local:MyListItem.Buttons>
</local:MyListItem> </local:MyListItem>
<local:MyListItem x:Name="ItemFabric" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="8" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="Fabric" <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"> 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> <local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}"> <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" /> <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> </x:Array>
</local:MyListItem.Buttons> </local:MyListItem.Buttons>
</local:MyListItem> </local:MyListItem>
<local:MyListItem x:Name="ItemLiteLoader" Visibility="Collapsed" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="9" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="LiteLoader" <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"> 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> <local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}"> <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" /> <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> </x:Array>
</local:MyListItem.Buttons> </local:MyListItem.Buttons>
</local:MyListItem> </local:MyListItem>
<TextBlock Text="资源" Margin="13,18,5,4" Opacity="0.6" FontSize="12" /> <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" <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"> 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> <local:MyListItem.Buttons>
<x:Array Type="{x:Type local:MyIconButton}"> <x:Array Type="{x:Type local:MyIconButton}">
@@ -84,6 +85,30 @@
</x:Array> </x:Array>
</local:MyListItem.Buttons> </local:MyListItem.Buttons>
</local:MyListItem> </local:MyListItem>
<local:MyListItem x:Name="ItemResourcePack" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="13" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="资源包"
LogoScale="0.98" Logo="M913.066667 264.533333l-371.2-209.066666c-25.6-12.8-59.733333-12.8-85.333334 0L89.6 264.533333C34.133333 298.666667 34.133333 379.733333 89.6 413.866667l371.2 209.066666c25.6 12.8 59.733333 12.8 85.333333 0l371.2-209.066666c55.466667-34.133333 55.466667-119.466667-4.266666-149.333334z m-413.866667 281.6L132.266667 337.066667 499.2 128l371.2 209.066667-371.2 209.066666z M46.933333 516.266667c12.8-21.333333 38.4-25.6 59.733334-17.066667l384 221.866667c12.8 8.533333 29.866667 8.533333 42.666666 0l388.266667-217.6c21.333333-12.8 46.933333-4.266667 59.733333 17.066666 12.8 21.333333 4.266667 46.933333-17.066666 59.733334l-388.266667 217.6c-38.4 21.333333-89.6 21.333333-128 0l-384-221.866667c-21.333333-12.8-25.6-38.4-17.066667-59.733333z M106.666667 669.866667c-21.333333-12.8-46.933333-4.266667-59.733334 17.066666-12.8 21.333333-4.266667 46.933333 17.066667 59.733334l388.266667 217.6c38.4 21.333333 85.333333 21.333333 128 0l379.733333-217.6c21.333333-12.8 25.6-38.4 17.066667-59.733334-12.8-21.333333-38.4-25.6-59.733334-17.066666l-379.733333 217.6c-12.8 8.533333-29.866667 8.533333-42.666667 0l-388.266666-217.6z">
<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="ItemShader" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="14" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="光影包"
LogoScale="0.98" Logo="M640 810.666667 384 810.666667c-25.6 0-42.666667-17.066667-42.666667-42.666667l0-21.333333c0-59.733333-25.6-119.466667-72.533333-166.4C200.533333 512 166.4 422.4 170.666667 328.533333 179.2 149.333333 328.533333 4.266667 507.733333 0L512 0c187.733333 0 341.333333 153.6 341.333333 341.333333 0 89.6-34.133333 179.2-102.4 243.2-46.933333 42.666667-68.266667 102.4-68.266667 162.133333L682.666667 768C682.666667 793.6 665.6 810.666667 640 810.666667zM426.666667 725.333333l170.666667 0c4.266667-76.8 38.4-145.066667 93.866667-204.8C742.4 473.6 768 409.6 768 341.333333c0-140.8-115.2-256-256-256l-4.266667 0C375.466667 89.6 260.266667 196.266667 256 332.8 251.733333 401.066667 281.6 469.333333 328.533333 520.533333 388.266667 580.266667 422.4 652.8 426.666667 725.333333z M512 1024 512 1024c-93.866667 0-170.666667-76.8-170.666667-170.666667l0-85.333333c0-25.6 17.066667-42.666667 42.666667-42.666667l256 0c25.6 0 42.666667 17.066667 42.666667 42.666667l0 85.333333C682.666667 947.2 605.866667 1024 512 1024zM426.666667 810.666667l0 42.666667c0 46.933333 38.4 85.333333 85.333333 85.333333L512 938.666667c46.933333 0 85.333333-38.4 85.333333-85.333333l0-42.666667L426.666667 810.666667z M384 384C358.4 384 341.333333 366.933333 341.333333 341.333333c0-93.866667 76.8-170.666667 170.666667-170.666667 25.6 0 42.666667 17.066667 42.666667 42.666667s-17.066667 42.666667-42.666667 42.666667c-46.933333 0-85.333333 38.4-85.333333 85.333333C426.666667 366.933333 409.6 384 384 384z">
<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="ItemDataPack" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="15" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="数据包"
LogoScale="0.98" Logo="M511.488 995.328a128.654222 128.654222 0 0 1-57.116444-13.112889L70.769778 791.808a126.833778 126.833778 0 0 1-70.769778-113.777778V311.608889a126.179556 126.179556 0 0 1 15.36-60.103111V248.604444c1.479111-2.901333 3.356444-5.603556 5.518222-8.021333a127.630222 127.630222 0 0 1 49.891556-42.325333L454.371556 13.368889a128.739556 128.739556 0 0 1 112.981333 0l383.601778 190.407111a126.862222 126.862222 0 0 1 72.049777 113.379556v360.874666a126.805333 126.805333 0 0 1-70.769777 115.939556L568.604444 984.32c-17.92 7.964444-37.461333 11.747556-57.116444 11.008z m42.638222-470.897778v370.204445l360.192-178.545778c14.449778-7.253333 23.552-21.987556 23.438222-38.087111v-335.928889L554.097778 524.430222zM85.248 330.666667v347.335111a42.268444 42.268444 0 0 0 23.438222 38.087111l360.192 178.545778V523.576889L85.248 330.666667zM135.537778 260.835556l375.950222 189.952 137.671111-65.564445L286.435556 188.074667 135.537778 260.864z m245.105778-118.471112l363.576888 197.973334 150.897778-71.480889-365.283555-180.224a42.922667 42.922667 0 0 0-37.518223 0l-111.672888 53.731555z">
<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>
<local:MyListItem x:Name="ItemShader" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="14" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="光影包" <local:MyListItem x:Name="ItemShader" Type="RadioBox" IsScaleAnimationEnabled="False" Tag="14" MinPaddingRight="35" Height="36" VerticalAlignment="Top" Title="光影包"
LogoScale="0.98" Logo="M640 810.666667 384 810.666667c-25.6 0-42.666667-17.066667-42.666667-42.666667l0-21.333333c0-59.733333-25.6-119.466667-72.533333-166.4C200.533333 512 166.4 422.4 170.666667 328.533333 179.2 149.333333 328.533333 4.266667 507.733333 0L512 0c187.733333 0 341.333333 153.6 341.333333 341.333333 0 89.6-34.133333 179.2-102.4 243.2-46.933333 42.666667-68.266667 102.4-68.266667 162.133333L682.666667 768C682.666667 793.6 665.6 810.666667 640 810.666667zM426.666667 725.333333l170.666667 0c4.266667-76.8 38.4-145.066667 93.866667-204.8C742.4 473.6 768 409.6 768 341.333333c0-140.8-115.2-256-256-256l-4.266667 0C375.466667 89.6 260.266667 196.266667 256 332.8 251.733333 401.066667 281.6 469.333333 328.533333 520.533333 388.266667 580.266667 422.4 652.8 426.666667 725.333333z M512 1024 512 1024c-93.866667 0-170.666667-76.8-170.666667-170.666667l0-85.333333c0-25.6 17.066667-42.666667 42.666667-42.666667l256 0c25.6 0 42.666667 17.066667 42.666667 42.666667l0 85.333333C682.666667 947.2 605.866667 1024 512 1024zM426.666667 810.666667l0 42.666667c0 46.933333 38.4 85.333333 85.333333 85.333333L512 938.666667c46.933333 0 85.333333-38.4 85.333333-85.333333l0-42.666667L426.666667 810.666667z M384 384C358.4 384 341.333333 366.933333 341.333333 341.333333c0-93.866667 76.8-170.666667 170.666667-170.666667 25.6 0 42.666667 17.066667 42.666667 42.666667s-17.066667 42.666667-42.666667 42.666667c-46.933333 0-85.333333 38.4-85.333333 85.333333C426.666667 366.933333 409.6 384 384 384z"> LogoScale="0.98" Logo="M640 810.666667 384 810.666667c-25.6 0-42.666667-17.066667-42.666667-42.666667l0-21.333333c0-59.733333-25.6-119.466667-72.533333-166.4C200.533333 512 166.4 422.4 170.666667 328.533333 179.2 149.333333 328.533333 4.266667 507.733333 0L512 0c187.733333 0 341.333333 153.6 341.333333 341.333333 0 89.6-34.133333 179.2-102.4 243.2-46.933333 42.666667-68.266667 102.4-68.266667 162.133333L682.666667 768C682.666667 793.6 665.6 810.666667 640 810.666667zM426.666667 725.333333l170.666667 0c4.266667-76.8 38.4-145.066667 93.866667-204.8C742.4 473.6 768 409.6 768 341.333333c0-140.8-115.2-256-256-256l-4.266667 0C375.466667 89.6 260.266667 196.266667 256 332.8 251.733333 401.066667 281.6 469.333333 328.533333 520.533333 388.266667 580.266667 422.4 652.8 426.666667 725.333333z M512 1024 512 1024c-93.866667 0-170.666667-76.8-170.666667-170.666667l0-85.333333c0-25.6 17.066667-42.666667 42.666667-42.666667l256 0c25.6 0 42.666667 17.066667 42.666667 42.666667l0 85.333333C682.666667 947.2 605.866667 1024 512 1024zM426.666667 810.666667l0 42.666667c0 46.933333 38.4 85.333333 85.333333 85.333333L512 938.666667c46.933333 0 85.333333-38.4 85.333333-85.333333l0-42.666667L426.666667 810.666667z M384 384C358.4 384 341.333333 366.933333 341.333333 341.333333c0-93.866667 76.8-170.666667 170.666667-170.666667 25.6 0 42.666667 17.066667 42.666667 42.666667s-17.066667 42.666667-42.666667 42.666667c-46.933333 0-85.333333 38.4-85.333333 85.333333C426.666667 366.933333 409.6 384 384 384z">
<local:MyListItem.Buttons> <local:MyListItem.Buttons>
@@ -93,5 +118,6 @@
</local:MyListItem.Buttons> </local:MyListItem.Buttons>
</local:MyListItem> </local:MyListItem>
</StackPanel> </StackPanel>
</local:MyScrollViewer>
</local:MyPageLeft> </local:MyPageLeft>
@@ -1,4 +1,5 @@
Public Class PageDownloadLeft Public Class PageDownloadLeft
Implements IRefreshable
#Region "页面切换" #Region "页面切换"
@@ -10,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, ItemShader.Check 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, ItemShader.Check, ItemResourcePack.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))
@@ -49,6 +50,9 @@
Case FormMain.PageSubType.DownloadShader Case FormMain.PageSubType.DownloadShader
If FrmDownloadShader Is Nothing Then FrmDownloadShader = New PageDownloadShader If FrmDownloadShader Is Nothing Then FrmDownloadShader = New PageDownloadShader
Return FrmDownloadShader Return FrmDownloadShader
Case FormMain.PageSubType.DownloadResourcePack
If FrmDownloadResourcePack Is Nothing Then FrmDownloadResourcePack = New PageDownloadResourcePack
Return FrmDownloadResourcePack
Case Else Case Else
Throw New Exception("未知的下载子页面种类:" & ID) Throw New Exception("未知的下载子页面种类:" & ID)
End Select End Select
@@ -64,7 +68,7 @@
PageChangeRun(PageGet(ID)) PageChangeRun(PageGet(ID))
PageID = ID PageID = ID
Catch ex As Exception Catch ex As Exception
Log(ex, "切换设置分页面失败(ID " & ID & ")", LogLevel.Feedback) Log(ex, "切换分页面失败(ID " & ID & ")", LogLevel.Feedback)
Finally Finally
AniControlEnabled -= 1 AniControlEnabled -= 1
End Try End Try
@@ -94,7 +98,13 @@
'强制刷新 '强制刷新
Public Sub Refresh(sender As Object, e As EventArgs) '由边栏按钮匿名调用 Public Sub Refresh(sender As Object, e As EventArgs) '由边栏按钮匿名调用
Select Case Val(sender.Tag) Refresh(Val(sender.Tag))
End Sub
Public Sub Refresh() Implements IRefreshable.Refresh
Refresh(FrmMain.PageCurrentSub)
End Sub
Public Sub Refresh(SubType As FormMain.PageSubType)
Select Case SubType
Case FormMain.PageSubType.DownloadInstall Case FormMain.PageSubType.DownloadInstall
DlClientListLoader.Start(IsForceRestart:=True) DlClientListLoader.Start(IsForceRestart:=True)
DlOptiFineListLoader.Start(IsForceRestart:=True) DlOptiFineListLoader.Start(IsForceRestart:=True)
@@ -109,12 +119,14 @@
PageDownloadMod.Storage = New CompProjectStorage PageDownloadMod.Storage = New CompProjectStorage
PageDownloadMod.Page = 0 PageDownloadMod.Page = 0
CompProjectCache.Clear() CompProjectCache.Clear()
CompFilesCache.Clear()
If FrmDownloadMod IsNot Nothing Then FrmDownloadMod.PageLoaderRestart() If FrmDownloadMod IsNot Nothing Then FrmDownloadMod.PageLoaderRestart()
ItemMod.Checked = True ItemMod.Checked = True
Case FormMain.PageSubType.DownloadPack Case FormMain.PageSubType.DownloadPack
PageDownloadPack.Storage = New CompProjectStorage PageDownloadPack.Storage = New CompProjectStorage
PageDownloadPack.Page = 0 PageDownloadPack.Page = 0
CompProjectCache.Clear() CompProjectCache.Clear()
CompFilesCache.Clear()
If FrmDownloadPack IsNot Nothing Then FrmDownloadPack.PageLoaderRestart() If FrmDownloadPack IsNot Nothing Then FrmDownloadPack.PageLoaderRestart()
ItemPack.Checked = True ItemPack.Checked = True
Case FormMain.PageSubType.DownloadShader Case FormMain.PageSubType.DownloadShader
@@ -123,6 +135,12 @@
CompProjectCache.Clear() CompProjectCache.Clear()
If FrmDownloadShader IsNot Nothing Then FrmDownloadShader.PageLoaderRestart() If FrmDownloadShader IsNot Nothing Then FrmDownloadShader.PageLoaderRestart()
ItemShader.Checked = True ItemShader.Checked = True
Case FormMain.PageSubType.DownloadResourcePack
PageDownloadResourcePack.Storage = New CompProjectStorage
PageDownloadResourcePack.Page = 0
CompProjectCache.Clear()
If FrmDownloadResourcePack IsNot Nothing Then FrmDownloadResourcePack.PageLoaderRestart()
ItemResourcePack.Checked = True
Case FormMain.PageSubType.DownloadClient Case FormMain.PageSubType.DownloadClient
DlClientListLoader.Start(IsForceRestart:=True) DlClientListLoader.Start(IsForceRestart:=True)
ItemClient.Checked = True ItemClient.Checked = True
@@ -33,20 +33,18 @@
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本" Margin="0,0,18,0" /> <TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本" Margin="0,0,18,0" />
<local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="1" Grid.ColumnSpan="2" IsEditable="True" MaxDropDownHeight="320"> <local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="1" Grid.ColumnSpan="2" IsEditable="True" MaxDropDownHeight="320">
<local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" /> <local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" />
<local:MyComboBoxItem Content="1.21.5" />
<local:MyComboBoxItem Content="1.21.4" />
<local:MyComboBoxItem Content="1.21.1" /> <local:MyComboBoxItem Content="1.21.1" />
<local:MyComboBoxItem Content="1.21" />
<local:MyComboBoxItem Content="1.20.6" /> <local:MyComboBoxItem Content="1.20.6" />
<local:MyComboBoxItem Content="1.20.4" />
<local:MyComboBoxItem Content="1.20.1" /> <local:MyComboBoxItem Content="1.20.1" />
<local:MyComboBoxItem Content="1.19.4" /> <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.17.1" /> <local:MyComboBoxItem Content="1.17.1" />
<local:MyComboBoxItem Content="1.16.5" /> <local:MyComboBoxItem Content="1.16.5" />
<local:MyComboBoxItem Content="1.15.2" />
<local:MyComboBoxItem Content="1.14.4" /> <local:MyComboBoxItem Content="1.14.4" />
<local:MyComboBoxItem Content="1.12.2" /> <local:MyComboBoxItem Content="1.12.2" />
<local:MyComboBoxItem Content="1.11.2" />
<local:MyComboBoxItem Content="1.10.2" /> <local:MyComboBoxItem Content="1.10.2" />
<local:MyComboBoxItem Content="1.8.9" /> <local:MyComboBoxItem Content="1.8.9" />
<local:MyComboBoxItem Content="1.7.10" /> <local:MyComboBoxItem Content="1.7.10" />
@@ -1,24 +1,62 @@
Public Class PageDownloadMod Public Class PageDownloadMod
Public Const PageSize = 40 Public Const PageSize = 40
''' <summary>
''' 在切换到该页面时自动设置的目标版本。
''' </summary>
Public Shared TargetVersion As McVersion = Nothing
'加载器信息 '加载器信息
Public Shared Loader As New LoaderTask(Of CompProjectRequest, Integer)("CompProject Mod", AddressOf CompProjectsGet, AddressOf LoaderInput) With {.ReloadTimeout = 60 * 1000} Public Shared Loader As New LoaderTask(Of CompProjectRequest, Integer)("CompProject Mod", AddressOf CompProjectsGet, AddressOf LoaderInput) With {.ReloadTimeout = 60 * 1000}
Public Shared Storage As New CompProjectStorage Public Shared Storage As New CompProjectStorage
Public Shared Page As Integer = 0 Public Shared Page As Integer = 0
Private Sub PageDownloadMod_Inited(sender As Object, e As EventArgs) Handles Me.Initialized Private IsLoaderInited As Boolean = False
Private Sub PageDownloadMod_Inited(sender As Object, e As EventArgs) Handles Me.Loaded
'不知道从 Initialized 改成 Loaded 会不会有问题,但用 Initialized 会导致初始的筛选器修改被覆盖回默认值
If TargetVersion IsNot Nothing Then
'设置目标
ResetFilter() '重置筛选器
TextSearchVersion.Text = TargetVersion.Version.McName
Dim GetTargetItemByName =
Function(Name As String) As MyComboBoxItem
For Each Item As MyComboBoxItem In ComboSearchLoader.Items
If Item.Content = Name Then Return Item
Next
Return ComboSearchLoader.Items(0)
End Function
If TargetVersion.Version.HasForge Then
ComboSearchLoader.SelectedItem = GetTargetItemByName("Forge")
ElseIf TargetVersion.Version.HasFabric Then
ComboSearchLoader.SelectedItem = GetTargetItemByName("Fabric")
ElseIf TargetVersion.Version.HasNeoForge Then
ComboSearchLoader.SelectedItem = GetTargetItemByName("NeoForge")
End If
TargetVersion = Nothing
'如果已经完成请求,则重新开始
If IsLoaderInited Then StartNewSearch()
PanScroll.ScrollToHome()
End If
'加载器初始化
If IsLoaderInited Then Return
IsLoaderInited = True
PageLoaderInit(Load, PanLoad, PanContent, PanAlways, Loader, AddressOf Load_OnFinish, AddressOf LoaderInput) 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))) If McVersionHighest = -1 Then McVersionHighest = Math.Max(McVersionHighest, Integer.Parse(CType(TextSearchVersion.Items(1), MyComboBoxItem).Content.ToString.Split(".")(1)))
End Sub End Sub
Private Shared Function LoaderInput() As CompProjectRequest Private Shared Function LoaderInput() As CompProjectRequest
Dim Request As New CompProjectRequest(CompType.Mod, Storage, (Page + 1) * PageSize) Dim Request As New CompProjectRequest(CompType.Mod, Storage, (Page + 1) * PageSize)
If FrmDownloadMod IsNot Nothing Then If FrmDownloadMod IsNot Nothing Then
Dim ModLoader As CompModLoaderType = Val(FrmDownloadMod.ComboSearchLoader.SelectedItem.Tag)
Dim GameVersion As String = If(FrmDownloadMod.TextSearchVersion.Text = "全部 (也可自行输入)", Nothing,
If(FrmDownloadMod.TextSearchVersion.Text.Contains(".") OrElse FrmDownloadMod.TextSearchVersion.Text.Contains("w"), FrmDownloadMod.TextSearchVersion.Text, Nothing))
If GameVersion IsNot Nothing AndAlso GameVersion.Contains(".") AndAlso Val(GameVersion.Split(".")(1)) < 14 AndAlso '1.14-
ModLoader = CompModLoaderType.Forge Then '选择了 Forge
ModLoader = CompModLoaderType.Any '此时,视作没有筛选 Mod Loader(因为部分老 Mod 没有设置自己支持的加载器)
End If
With Request With Request
.SearchText = FrmDownloadMod.TextSearchName.Text .SearchText = FrmDownloadMod.TextSearchName.Text
.GameVersion = If(FrmDownloadMod.TextSearchVersion.Text = "全部 (也可自行输入)", Nothing, .GameVersion = GameVersion
If(FrmDownloadMod.TextSearchVersion.Text.Contains(".") OrElse FrmDownloadMod.TextSearchVersion.Text.Contains("w"), FrmDownloadMod.TextSearchVersion.Text, Nothing))
.Tag = FrmDownloadMod.ComboSearchTag.SelectedItem.Tag .Tag = FrmDownloadMod.ComboSearchTag.SelectedItem.Tag
.ModLoader = Val(FrmDownloadMod.ComboSearchLoader.SelectedItem.Tag) .ModLoader = ModLoader
.Source = CType(Val(FrmDownloadMod.ComboSearchSource.SelectedItem.Tag), CompSourceType) .Source = CType(Val(FrmDownloadMod.ComboSearchSource.SelectedItem.Tag), CompSourceType)
End With End With
End If End If
@@ -112,7 +150,7 @@
End Sub End Sub
'重置按钮 '重置按钮
Private Sub BtnSearchReset_Click(sender As Object, e As EventArgs) Handles BtnSearchReset.Click Private Sub ResetFilter() Handles BtnSearchReset.Click
TextSearchName.Text = "" TextSearchName.Text = ""
TextSearchVersion.Text = "全部 (也可自行输入)" TextSearchVersion.Text = "全部 (也可自行输入)"
TextSearchVersion.SelectedIndex = 0 TextSearchVersion.SelectedIndex = 0
@@ -8,14 +8,12 @@
<StackPanel Orientation="Vertical" Margin="5"> <StackPanel Orientation="Vertical" Margin="5">
<local:MyCard Margin="20,20,20,0" Grid.IsSharedSizeScope="True" Title="OptiFine 简介" x:Name="CardTip"> <local:MyCard Margin="20,20,20,0" Grid.IsSharedSizeScope="True" Title="OptiFine 简介" x:Name="CardTip">
<StackPanel Margin="25,40,15,20"> <StackPanel Margin="25,40,15,20">
<TextBlock Name="LabConnect" Margin="0,0,0,11" Text="OptiFine 又名高清修复,它让你可以安装光影、使用高清材质,并且可以大幅提高游戏性能。" TextWrapping="Wrap" /> <TextBlock Name="LabConnect" Margin="0,0,0,11" Text="OptiFine 又称为高清修复,以允许安装光影、使用高清材质、提高游戏性能,但与 Mod 的兼容性不佳。" TextWrapping="Wrap" />
<Grid Height="35"> <Grid Height="35">
<Grid.ColumnDefinitions> <Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" /> <ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions> </Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnChina" Grid.Column="0" MinWidth="140" Text="打开中文网" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ColorType="Highlight" /> <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="BtnWeb" Grid.Column="1" MinWidth="140" Text="打开官网" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" />
</Grid> </Grid>
</StackPanel> </StackPanel>
</local:MyCard> </local:MyCard>
@@ -49,8 +49,5 @@
Private Sub BtnWeb_Click(sender As Object, e As EventArgs) Handles BtnWeb.Click Private Sub BtnWeb_Click(sender As Object, e As EventArgs) Handles BtnWeb.Click
OpenWebsite("https://www.optifine.net/") OpenWebsite("https://www.optifine.net/")
End Sub End Sub
Private Sub BtnChina_Click(sender As Object, e As EventArgs) Handles BtnChina.Click
OpenWebsite("https://optifine.cn/home")
End Sub
End Class End Class
@@ -32,20 +32,18 @@
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本" Margin="0,0,18,0" /> <TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本" Margin="0,0,18,0" />
<local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="1" IsEditable="True" MaxDropDownHeight="320"> <local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="1" IsEditable="True" MaxDropDownHeight="320">
<local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" /> <local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" />
<local:MyComboBoxItem Content="1.21.5" />
<local:MyComboBoxItem Content="1.21.4" />
<local:MyComboBoxItem Content="1.21.1" /> <local:MyComboBoxItem Content="1.21.1" />
<local:MyComboBoxItem Content="1.21" />
<local:MyComboBoxItem Content="1.20.6" /> <local:MyComboBoxItem Content="1.20.6" />
<local:MyComboBoxItem Content="1.20.4" />
<local:MyComboBoxItem Content="1.20.1" /> <local:MyComboBoxItem Content="1.20.1" />
<local:MyComboBoxItem Content="1.19.4" /> <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.17.1" /> <local:MyComboBoxItem Content="1.17.1" />
<local:MyComboBoxItem Content="1.16.5" /> <local:MyComboBoxItem Content="1.16.5" />
<local:MyComboBoxItem Content="1.15.2" />
<local:MyComboBoxItem Content="1.14.4" /> <local:MyComboBoxItem Content="1.14.4" />
<local:MyComboBoxItem Content="1.12.2" /> <local:MyComboBoxItem Content="1.12.2" />
<local:MyComboBoxItem Content="1.11.2" />
<local:MyComboBoxItem Content="1.10.2" /> <local:MyComboBoxItem Content="1.10.2" />
<local:MyComboBoxItem Content="1.8.9" /> <local:MyComboBoxItem Content="1.8.9" />
<local:MyComboBoxItem Content="1.7.10" /> <local:MyComboBoxItem Content="1.7.10" />
@@ -0,0 +1,126 @@
<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="PageDownloadResourcePack"
PanScroll="{Binding ElementName=PanBack}">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel Orientation="Vertical" Margin="25">
<local:MyCard Title="搜索资源包" Margin="0,0,0,15" x:Name="PanAlways">
<StackPanel Margin="25,40,25,15">
<Grid Margin="0,0,0,11" HorizontalAlignment="Stretch">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="2.5*" />
<ColumnDefinition Width="50" />
<ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" />
</Grid.ColumnDefinitions>
<Grid.RowDefinitions>
<RowDefinition Height="28" />
<RowDefinition Height="9" />
<RowDefinition Height="28" />
</Grid.RowDefinitions>
<TextBlock VerticalAlignment="Center" HorizontalAlignment="Left" Text="名称" Margin="0,0,18,0" />
<local:MyTextBox x:Name="TextSearchName" Grid.Column="1" />
<TextBlock VerticalAlignment="Center" Grid.Column="3" HorizontalAlignment="Left" Text="来源" Margin="0,0,18,0" />
<local:MyComboBox x:Name="ComboSearchSource" Grid.Column="4">
<local:MyComboBoxItem Content="全部" Tag="3" IsSelected="True" />
<local:MyComboBoxItem Content="CurseForge" Tag="1" />
<local:MyComboBoxItem Content="Modrinth" Tag="2" />
</local:MyComboBox>
<TextBlock VerticalAlignment="Center" Grid.Row="2" HorizontalAlignment="Left" Text="版本" Margin="0,0,18,0" />
<local:MyComboBox x:Name="TextSearchVersion" Grid.Row="2" Grid.Column="1" IsEditable="True" MaxDropDownHeight="320">
<local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" />
<local:MyComboBoxItem Content="1.20.6" />
<local:MyComboBoxItem Content="1.20.4" />
<local:MyComboBoxItem Content="1.20.1" />
<local:MyComboBoxItem Content="1.19.4" />
<local:MyComboBoxItem Content="1.19.2" />
<local:MyComboBoxItem Content="1.18.2" />
<local:MyComboBoxItem Content="1.17.1" />
<local:MyComboBoxItem Content="1.16.5" />
<local:MyComboBoxItem Content="1.15.2" />
<local:MyComboBoxItem Content="1.14.4" />
<local:MyComboBoxItem Content="1.12.2" />
<local:MyComboBoxItem Content="1.11.2" />
<local:MyComboBoxItem Content="1.10.2" />
<local:MyComboBoxItem Content="1.8.9" />
<local:MyComboBoxItem Content="1.7.10" />
</local:MyComboBox>
<TextBlock VerticalAlignment="Center" Grid.Row="2" Grid.Column="3" HorizontalAlignment="Left" Text="类型" Margin="0,0,18,0" />
<local:MyComboBox x:Name="ComboSearchTag" Grid.Column="4" Grid.Row="2" MaxDropDownHeight="320">
<local:MyComboBoxItem Tag="" Content="全部" IsSelected="True" />
<local:MyComboBoxItem Content="8x-" Tag="/8x-" />
<local:MyComboBoxItem Content="16x" Tag="393/16x" />
<local:MyComboBoxItem Content="32x" Tag="394/32x" />
<local:MyComboBoxItem Content="48x" Tag="/48x" />
<local:MyComboBoxItem Content="64x" Tag="395/64x" />
<local:MyComboBoxItem Content="128x" Tag="396/128x" />
<local:MyComboBoxItem Content="256x" Tag="397/256x" />
<local:MyComboBoxItem Content="512x+" Tag="398/512x+" />
<local:MyComboBoxItem Content="声音" Tag="/audio" />
<local:MyComboBoxItem Content="方块" Tag="/blocks" />
<local:MyComboBoxItem Content="战斗" Tag="/combat" />
<local:MyComboBoxItem Content="核心着色器" Tag="/core-shaders" />
<local:MyComboBoxItem Content="Cursed" Tag="/cursed" />
<local:MyComboBoxItem Content="装饰" Tag="/decoration" />
<local:MyComboBoxItem Content="实体" Tag="/entities" />
<local:MyComboBoxItem Content="环境" Tag="/environment" />
<local:MyComboBoxItem Content="装备" Tag="/equipment" />
<local:MyComboBoxItem Content="字体" Tag="/fonts" />
<local:MyComboBoxItem Content="GUI" Tag="/gui" />
<local:MyComboBoxItem Content="物品" Tag="/items" />
<local:MyComboBoxItem Content="本地化" Tag="/locale" />
<local:MyComboBoxItem Content="Modded" Tag="4465/modded" />
<local:MyComboBoxItem Content="模型" Tag="/models" />
<local:MyComboBoxItem Content="写实" Tag="400/realistic" />
<local:MyComboBoxItem Content="扁平" Tag="/simplistic" />
<local:MyComboBoxItem Content="主题" Tag="/themed" />
<local:MyComboBoxItem Content="优化" Tag="/tweaks" />
<local:MyComboBoxItem Content="实用" Tag="/utility" />
<local:MyComboBoxItem Content="类原生" Tag="/vanilla-like" />
<local:MyComboBoxItem Content="动态效果" Tag="404/" />
<local:MyComboBoxItem Content="传统" Tag="403/" />
<local:MyComboBoxItem Content="中世纪" Tag="402/" />
<local:MyComboBoxItem Content="蒸汽朋克" Tag="399/" />
<local:MyComboBoxItem Content="现代" Tag="401/" />
<local:MyComboBoxItem Content="字体包" Tag="5244/" />
<local:MyComboBoxItem Content="含有数据包" Tag="5193/" />
<local:MyComboBoxItem Content="其他" Tag="405/" />
</local:MyComboBox>
</Grid>
<Grid Margin="0,4,0,6" Height="35">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
</Grid.ColumnDefinitions>
<local:MyButton x:Name="BtnSearchRun" Text="搜索" MinWidth="140" Padding="13,0" Margin="0,0,20,0" ColorType="Highlight" />
<local:MyButton x:Name="BtnSearchReset" Text="重置条件" MinWidth="140" Padding="13,0" Margin="0,0,20,0" Grid.Column="1" />
</Grid>
</StackPanel>
</local:MyCard>
<StackPanel x:Name="PanContent">
<local:MyHint x:Name="HintError" Text="无法连接到 Modrinth,所以目前仅显示了来自 CurseForge 的内容,结果可能不全。&#xa;请尝试使用 VPN 或加速器以改善网络。" IsWarn="True" Margin="0,0,0,15" />
<local:MyCard x:Name="CardProjects" UseAnimation="False">
<StackPanel x:Name="PanProjects" Margin="12" />
</local:MyCard>
<local:MyCard Margin="0,15,0,0" x:Name="CardPages" HorizontalAlignment="Center">
<StackPanel Orientation="Horizontal" Height="23" Margin="10,7">
<local:MyIconButton x:Name="BtnPageFirst" IsEnabled="False" Opacity="0.2" Margin="0,0.5,5,0.5"
Logo="M496.213333 329.856L315.306667 510.848l180.992 181.077333a42.666667 42.666667 0 1 1-60.330667 60.330667l-211.2-211.2a42.453333 42.453333 0 0 1-11.818667-22.613333l-0.597333-5.034667v-5.034667a42.496 42.496 0 0 1 12.373333-27.648l211.2-211.2a42.666667 42.666667 0 0 1 60.373334 60.330667z m298.666667 0l-180.949333 180.992 180.992 181.077333a42.666667 42.666667 0 1 1-60.330667 60.330667l-211.2-211.2a42.453333 42.453333 0 0 1-11.818667-22.613333l-0.597333-5.034667v-5.034667a42.496 42.496 0 0 1 12.373333-27.648l211.2-211.2a42.666667 42.666667 0 0 1 60.373334 60.330667z" />
<local:MyIconButton x:Name="BtnPageLeft" IsEnabled="False" Opacity="0.2" Margin="0,0,5,0"
Logo="M650.752 278.357333l-241.322667 241.365334 241.322667 241.365333a42.666667 42.666667 0 1 1-60.330667 60.330667l-271.530666-271.530667a42.453333 42.453333 0 0 1-11.818667-22.613333l-0.597333-5.034667v-5.034667a42.496 42.496 0 0 1 12.416-27.648l271.530666-271.530666a42.666667 42.666667 0 0 1 60.330667 60.330666z" />
<TextBlock x:Name="LabPage" Text="1"
Margin="8,0,13,0" FontSize="15" VerticalAlignment="Center" Foreground="{DynamicResource ColorBrush3}" />
<local:MyIconButton x:Name="BtnPageRight" Margin="0,0,30,0"
Logo="M404.309333 278.357333l241.322667 241.365334-241.322667 241.365333a42.666667 42.666667 0 1 0 60.330667 60.330667l271.530667-271.530667a42.453333 42.453333 0 0 0 11.818666-22.613333l0.597334-5.034667v-5.034667a42.496 42.496 0 0 0-12.416-27.648L464.64 218.026667a42.666667 42.666667 0 0 0-60.330667 60.330666z" />
</StackPanel>
</local:MyCard>
</StackPanel>
<local:MyCard HorizontalAlignment="Center" VerticalAlignment="Center" SnapsToDevicePixels="True" x:Name="PanLoad" UseAnimation="False" Margin="40,50">
<local:MyLoading Text="正在获取资源包列表" Margin="20,20,20,17" x:Name="Load" HorizontalAlignment="Center" VerticalAlignment="Center" />
</local:MyCard>
</StackPanel>
</local:MyScrollViewer>
</local:MyPageRight>
@@ -0,0 +1,124 @@
Public Class PageDownloadResourcePack
Public Const PageSize = 40
'加载器信息
Public Shared Loader As New LoaderTask(Of CompProjectRequest, Integer)("CompProject ResourcePack", AddressOf CompProjectsGet, AddressOf LoaderInput) With {.ReloadTimeout = 60 * 1000}
Public Shared Storage As New CompProjectStorage
Public Shared Page As Integer = 0
Private Sub PageDownloadResourcePack_Inited(sender As Object, e As EventArgs) Handles Me.Initialized
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)))
End Sub
Private Shared Function LoaderInput() As CompProjectRequest
Dim Request As New CompProjectRequest(CompType.ResourcePack, Storage, (Page + 1) * PageSize)
If FrmDownloadResourcePack IsNot Nothing Then
With Request
.SearchText = FrmDownloadResourcePack.TextSearchName.Text
.GameVersion = If(FrmDownloadResourcePack.TextSearchVersion.Text = "全部 (也可自行输入)", Nothing,
If(FrmDownloadResourcePack.TextSearchVersion.Text.Contains(".") OrElse FrmDownloadResourcePack.TextSearchVersion.Text.Contains("w"), FrmDownloadResourcePack.TextSearchVersion.Text, Nothing))
.Tag = FrmDownloadResourcePack.ComboSearchTag.SelectedItem.Tag
.Source = CType(Val(FrmDownloadResourcePack.ComboSearchSource.SelectedItem.Tag), CompSourceType)
End With
End If
Return Request
End Function
'结果 UI 化
Private Sub Load_OnFinish()
Try
Log($"[Comp] 开始可视化资源包列表,已储藏 {Storage.Results.Count} 个结果,当前在第 {Page + 1} 页")
'列表项
PanProjects.Children.Clear()
For i = Math.Min(Page * PageSize, Storage.Results.Count - 1) To Math.Min((Page + 1) * PageSize - 1, Storage.Results.Count - 1)
PanProjects.Children.Add(Storage.Results(i).ToCompItem(Loader.Input.GameVersion Is Nothing, False))
Next
'页码
CardPages.Visibility = If(Storage.Results.Count > 40 OrElse
Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal,
Visibility.Visible, Visibility.Collapsed)
LabPage.Text = Page + 1
BtnPageFirst.IsEnabled = Page > 1
BtnPageFirst.Opacity = If(Page > 1, 1, 0.2)
BtnPageLeft.IsEnabled = Page > 0
BtnPageLeft.Opacity = If(Page > 0, 1, 0.2)
Dim IsRightEnabled As Boolean = '由于 WPF 的未知 bug,读取到的 IsEnabled 可能是错误的值(#3319)
Storage.Results.Count > PageSize * (Page + 1) OrElse
Storage.CurseForgeOffset < Storage.CurseForgeTotal OrElse Storage.ModrinthOffset < Storage.ModrinthTotal
BtnPageRight.IsEnabled = IsRightEnabled
BtnPageRight.Opacity = If(IsRightEnabled, 1, 0.2)
'错误信息
If Storage.ErrorMessage Is Nothing Then
HintError.Visibility = Visibility.Collapsed
Else
HintError.Visibility = Visibility.Visible
HintError.Text = Storage.ErrorMessage
End If
'强制返回顶部
PanBack.ScrollToTop()
Catch ex As Exception
Log(ex, "可视化资源包列表出错", LogLevel.Feedback)
End Try
End Sub
'自动重试
Private Sub Load_State(sender As Object, state As MyLoading.MyLoadingState, oldState As MyLoading.MyLoadingState) Handles Load.StateChanged
Select Case Loader.State
Case LoadState.Failed
Dim ErrorMessage As String = ""
If Loader.Error IsNot Nothing Then ErrorMessage = Loader.Error.Message
If ErrorMessage.Contains("不是有效的 json 文件") Then
Log("[Download] 下载的资源包列表 json 文件损坏,已自动重试", LogLevel.Debug)
PageLoaderRestart()
End If
End Select
End Sub
'切换页码
Private Sub BtnPageFirst_Click(sender As Object, e As RoutedEventArgs) Handles BtnPageFirst.Click
ChangePage(0)
End Sub
Private Sub BtnPageLeft_Click(sender As Object, e As RoutedEventArgs) Handles BtnPageLeft.Click
ChangePage(Page - 1)
End Sub
Private Sub BtnPageRight_Click(sender As Object, e As RoutedEventArgs) Handles BtnPageRight.Click
ChangePage(Page + 1)
End Sub
Private Sub ChangePage(NewPage As Integer)
CardPages.IsEnabled = False
Page = NewPage
FrmMain.BackToTop()
Log($"[Download] 资源包切换到第 {Page + 1} 页")
RunInThread(Sub()
Thread.Sleep(100) '等待向上滚的动画结束
RunInUi(Sub() CardPages.IsEnabled = True)
Loader.Start()
End Sub)
End Sub
#Region "搜索"
'搜索按钮
Private Sub StartNewSearch() Handles BtnSearchRun.Click
Page = 0
If Loader.ShouldStart(LoaderInput()) Then Storage = New CompProjectStorage '避免连续搜索两次使得 CompProjectStorage 引用丢失(#1311)
Loader.Start()
End Sub
Private Sub EnterTrigger(sender As Object, e As KeyEventArgs) Handles TextSearchName.KeyDown, TextSearchVersion.KeyDown
If e.Key = Key.Enter Then StartNewSearch()
End Sub
'重置按钮
Private Sub BtnSearchReset_Click(sender As Object, e As EventArgs) Handles BtnSearchReset.Click
TextSearchName.Text = ""
TextSearchVersion.Text = "全部 (也可自行输入)"
TextSearchVersion.SelectedIndex = 0
ComboSearchSource.SelectedIndex = 0
ComboSearchTag.SelectedIndex = 0
Loader.LastFinishedTime = 0 '要求强制重新开始
End Sub
#End Region
End Class
@@ -1,28 +0,0 @@
<Window x:Class="FormLoginOAuth"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:d="http://schemas.microsoft.com/expression/blend/2008"
xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
xmlns:local="clr-namespace:PCL"
mc:Ignorable="d"
Height="720" Width="580" MinHeight="720" MinWidth="580" ResizeMode="CanResize" WindowStartupLocation="CenterScreen" Title="Microsoft 账户登录">
<Grid>
<Grid.Background>
<LinearGradientBrush EndPoint="0.5,1" StartPoint="0.5,0">
<GradientStop Color="White" Offset="0"/>
<GradientStop Color="{DynamicResource ColorObject8}" Offset="1"/>
</LinearGradientBrush>
</Grid.Background>
<StackPanel x:Name="PanLoading" Orientation="Vertical" VerticalAlignment="Center" HorizontalAlignment="Center">
<local:MyLoading x:Name="Loading" Text="正在加载登录页面" HorizontalAlignment="Center" />
<TextBlock Text="如果网络环境不佳,加载可能非常缓慢甚至一直加载不出来" Margin="0,25,0,0"
HorizontalAlignment="Center" Foreground="{DynamicResource ColorBrush1}" Opacity="0.7" />
<TextBlock Text="此时请尝试使用 VPN 或加速器,然后重试"
HorizontalAlignment="Center" Foreground="{DynamicResource ColorBrush1}" Opacity="0.7" />
</StackPanel>
<WebBrowser x:Name="Browser1" Visibility="Collapsed" Tag="1" Margin="0,0,0,25" />
<WebBrowser x:Name="Browser2" Visibility="Collapsed" Tag="2" Margin="0,0,0,25" />
<WebBrowser x:Name="Browser3" Visibility="Collapsed" Tag="3" Margin="0,0,0,25" />
<local:MyTextButton Text="如果遇到问题,可以点击这里使用系统浏览器登录" HorizontalAlignment="Center" VerticalAlignment="Bottom" Margin="0,0,0,5" x:Name="HintSwitch" />
</Grid>
</Window>
@@ -1,100 +0,0 @@
Imports System.Windows.Navigation
Public Class FormLoginOAuth
Public Event OnLoginSuccess(code As String)
Public Event OnLoginCanceled(IsSwitch As Boolean)
'跳转事件
Private IsLoginSuccessed As Boolean = False
Private IsSwitch As Boolean = False
Private Sub Browser_Navigating(sender As WebBrowser, e As NavigatingCancelEventArgs) Handles Browser1.Navigating, Browser2.Navigating, Browser3.Navigating
Dim Url As String = e.Uri.AbsoluteUri
If ModeDebug Then Log("[Login] 登录浏览器 " & sender.Tag & " 导向:" & Url)
If Url.Contains("code=") Then
Dim Code As String = RegexSeek(Url, "(?<=code\=)[^&]+")
Log("[Login] 抓取到 OAuth 返回码:" & Code)
IsLoginSuccessed = True
RaiseEvent OnLoginSuccess(Code)
ElseIf Url.Contains("github.") Then
Hint("PCL 不支持使用 GitHub 登录微软账号!", HintType.Critical)
Close()
End If
End Sub
'已导航事件
Private IsFirstLoaded As Boolean = False
Private IsFirstLoadedLock As New Object
Private Sub Browser_Navigated(sender As WebBrowser, e As NavigationEventArgs) Handles Browser1.Navigated, Browser2.Navigated, Browser3.Navigated
SyncLock IsFirstLoadedLock
If IsFirstLoaded Then Exit Sub
IsFirstLoaded = True
End SyncLock
RunInThread(Sub()
Thread.Sleep(1000)
RunInUi(Sub()
sender.Visibility = Visibility.Visible
PanLoading.Visibility = Visibility.Collapsed
Log("[Login] 已将登录窗口切换至浏览器")
End Sub)
End Sub)
End Sub
'窗体的进出事件
Public Shared LoginUrl1 As String = "https://login.microsoftonline.com/consumers/oauth2/v2.0/authorize?prompt=login&client_id=00000000402b5328&response_type=code&scope=service%3A%3Auser.auth.xboxlive.com%3A%3AMBI_SSL&redirect_uri=https:%2F%2Flogin.live.com%2Foauth20_desktop.srf"
Public Shared LoginUrl2 As String = "https://login.live.com/oauth20_authorize.srf?prompt=login&client_id=00000000402b5328&response_type=code&scope=service%3A%3Auser.auth.xboxlive.com%3A%3AMBI_SSL&redirect_uri=https:%2F%2Flogin.live.com%2Foauth20_desktop.srf"
Private Sub FrmLoginOAuth_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
Browser1.Navigate(LoginUrl1)
RunInThread(Sub()
'估计是由于时间戳原因,同时导航会导致误报密码失败
Thread.Sleep(2500)
RunInUi(Sub()
Try '防止在 Dispose 之后调用
If Not IsFirstLoaded Then Browser2.Navigate(LoginUrl1)
Catch
End Try
End Sub)
Thread.Sleep(2500)
RunInUi(Sub()
Try
If Not IsFirstLoaded Then Browser3.Navigate(LoginUrl2)
Catch
End Try
End Sub)
End Sub)
End Sub
Private Sub FormLoginOAuth_Closed() Handles Me.Closed
RunInThread(Sub()
Thread.Sleep(1000) '释放会卡一下,所以稍等一下……
RunInUiWait(Sub()
Try
Browser1.Dispose()
Catch ex As Exception
Log(ex, "释放微软登录浏览器 1 失败")
End Try
End Sub)
Thread.Sleep(200)
RunInUiWait(Sub()
Try
Browser2.Dispose()
Catch ex As Exception
Log(ex, "释放微软登录浏览器 2 失败")
End Try
End Sub)
Thread.Sleep(200)
RunInUiWait(Sub()
Try
Browser3.Dispose()
Catch ex As Exception
Log(ex, "释放微软登录浏览器 3 失败")
End Try
End Sub)
End Sub)
If Not IsLoginSuccessed Then RaiseEvent OnLoginCanceled(IsSwitch)
FrmMain.Focus()
End Sub
Private Sub HintSwitch_Click() Handles HintSwitch.Click
IsSwitch = True
Close()
End Sub
End Class
@@ -0,0 +1,40 @@
<Grid x:Class="MyMsgLogin"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:my="clr-namespace:PCL"
RenderTransformOrigin="0,0.5" UseLayoutRounding="True" SnapsToDevicePixels="True" MinWidth="400" HorizontalAlignment="Center" VerticalAlignment="Center" Margin="25">
<Grid.RenderTransform>
<TransformGroup>
<RotateTransform x:Name="TransformRotate" Angle="-4" />
<TranslateTransform x:Name="TransformPos" X="0" Y="40" />
</TransformGroup>
</Grid.RenderTransform>
<Border Name="PanBorder" CornerRadius="7" Background="#FBFBFB">
<Border.Effect>
<DropShadowEffect Color="{DynamicResource ColorObject1}" BlurRadius="20" ShadowDepth="4" RenderingBias="Performance" Opacity="0.8" x:Name="EffectShadow" />
</Border.Effect>
<Grid Name="PanMain" VerticalAlignment="Top" Margin="22,22,22,23">
<Grid.RowDefinitions>
<RowDefinition Height="Auto" />
<RowDefinition Height="2" />
<RowDefinition Height="13" />
<RowDefinition Height="1*" />
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<TextBlock Grid.Row="0" FontSize="23" TextTrimming="None" Foreground="{DynamicResource ColorBrush2}" HorizontalAlignment="Left" Name="LabTitle" Margin="7,-1,70,9" Text="测试标题文本" VerticalAlignment="Top" SnapsToDevicePixels="False" UseLayoutRounding="False" />
<Rectangle x:Name="ShapeLine" Grid.Row="1" Height="2" Fill="{Binding Foreground, ElementName=LabTitle}" />
<my:MyScrollViewer Grid.Row="3" VerticalAlignment="Top" x:Name="PanCaption" Margin="0,0,0,17" Padding="7,0,15,0"
VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" DeltaMult="0.7">
<TextBlock VerticalAlignment="Top" TextTrimming="None" TextWrapping="Wrap" Name="LabCaption" FontSize="15" LineHeight="18"
Foreground="#FF5C5C5C" FontWeight="Normal" Padding="1" />
</my:MyScrollViewer>
<StackPanel Grid.Row="4" Name="PanBtn" VerticalAlignment="Top" HorizontalAlignment="Right" Margin="150,0,8,0" Orientation="Horizontal">
<my:MyButton ColorType="Normal" x:FieldModifier="public" Text="重新打开网页" x:Name="Btn1" Margin="12,0,0,0" TextPadding="7" SnapsToDevicePixels="False" Padding="5,0" UseLayoutRounding="False"
EventType="打开网页" />
<my:MyButton ColorType="Normal" x:FieldModifier="public" Text="复制代码" x:Name="Btn2" Margin="12,0,0,0" TextPadding="7" SnapsToDevicePixels="False" Padding="5,0" UseLayoutRounding="False"
EventType="复制文本" />
<my:MyButton ColorType="Normal" x:FieldModifier="public" Text="取消" x:Name="Btn3" Margin="12,0,0,0" TextPadding="7" SnapsToDevicePixels="False" Padding="5,0" UseLayoutRounding="False" />
</StackPanel>
</Grid>
</Border>
</Grid>
@@ -0,0 +1,145 @@
Public Class MyMsgLogin
Private Data As JObject
Private UserCode As String '需要用户在网页上输入的设备代码
Private DeviceCode As String '用于轮询的设备代码
Private Website As String '验证网页的网址
#Region "弹窗"
Private ReadOnly MyConverter As MyMsgBoxConverter
Private ReadOnly Uuid As Integer = GetUuid()
Public Sub New(Converter As MyMsgBoxConverter)
Try
InitializeComponent()
Btn1.Name = Btn1.Name & GetUuid()
Btn2.Name = Btn2.Name & GetUuid()
Btn3.Name = Btn3.Name & GetUuid()
MyConverter = Converter
ShapeLine.StrokeThickness = GetWPFSize(1)
Data = Converter.Content
Init()
Catch ex As Exception
Log(ex, "登录弹窗初始化失败", LogLevel.Hint)
End Try
End Sub
Private Sub Load(sender As Object, e As EventArgs) Handles MyBase.Loaded
Try
'动画
Opacity = 0
AniStart(AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, If(MyConverter.IsWarn, New MyColor(140, 80, 0, 0), New MyColor(90, 0, 0, 0)) - FrmMain.PanMsg.Background, 200), "PanMsg Background")
AniStart({
AaOpacity(Me, 1, 120, 60),
AaDouble(Sub(i) TransformPos.Y += i, -TransformPos.Y, 300, 60, New AniEaseOutBack(AniEasePower.Weak)),
AaDouble(Sub(i) TransformRotate.Angle += i, -TransformRotate.Angle, 300, 60, New AniEaseOutFluent(AniEasePower.Weak))
}, "MyMsgBox " & Uuid)
'记录日志
Log("[Control] 登录弹窗:" & LabTitle.Text & vbCrLf & LabCaption.Text)
Catch ex As Exception
Log(ex, "登录弹窗加载失败", LogLevel.Hint)
End Try
End Sub
Private Sub Close()
'动画
AniStart({
AaCode(
Sub()
If Not WaitingMyMsgBox.Any() Then
AniStart(AaColor(FrmMain.PanMsg, Grid.BackgroundProperty, New MyColor(0, 0, 0, 0) - FrmMain.PanMsg.Background, 200, Ease:=New AniEaseOutFluent(AniEasePower.Weak)))
End If
End Sub, 30),
AaOpacity(Me, -Opacity, 80, 20),
AaDouble(Sub(i) TransformPos.Y += i, 20 - TransformPos.Y, 150, 0, New AniEaseOutFluent),
AaDouble(Sub(i) TransformRotate.Angle += i, 6 - TransformRotate.Angle, 150, 0, New AniEaseInFluent(AniEasePower.Weak)),
AaCode(Sub() CType(Parent, Grid).Children.Remove(Me), , True)
}, "MyMsgBox " & Uuid)
End Sub
'实现回车和 Esc 的接口(#4857)
Public Sub Btn1_Click() Handles Btn1.Click
End Sub
Public Sub Btn3_Click() Handles Btn3.Click
Finished(New ThreadInterruptedException)
End Sub
Private Sub Drag(sender As Object, e As MouseButtonEventArgs) Handles PanBorder.MouseLeftButtonDown, LabTitle.MouseLeftButtonDown
On Error Resume Next
If e.GetPosition(ShapeLine).Y <= 2 Then FrmMain.DragMove()
End Sub
#End Region
Private Sub Finished(Result As Object)
If MyConverter.IsExited Then Return
MyConverter.IsExited = True
MyConverter.Result = Result
RunInUi(AddressOf Close)
Thread.Sleep(200)
FrmMain.ShowWindowToTop()
End Sub
Private Sub Init()
UserCode = Data("user_code")
DeviceCode = Data("device_code")
Website = Data("verification_uri")
'设置 UI
LabTitle.Text = "登录 Minecraft"
LabCaption.Text =
$"登录网页将自动开启,请在网页中输入 {UserCode}(已自动复制)。" & vbCrLf & vbCrLf &
$"如果网络环境不佳,网页可能一直加载不出来,届时请使用 VPN 并重试。" & vbCrLf &
$"你也可以用其他设备打开 {Website} 并输入上述代码。"
Btn1.EventData = Website
Btn2.EventData = UserCode
'启动工作线程
RunInNewThread(AddressOf WorkThread, "MyMsgLogin")
End Sub
Private Sub WorkThread()
Thread.Sleep(3000)
If MyConverter.IsExited Then Exit Sub
OpenWebsite(Website)
ClipboardSet(UserCode)
Thread.Sleep((Data("interval").ToObject(Of Integer) - 1) * 1000)
'轮询
Dim UnknownFailureCount As Integer = 0
Do While Not MyConverter.IsExited
Try
Dim Result = NetRequestOnce(
"https://login.microsoftonline.com/consumers/oauth2/v2.0/token", "POST",
"grant_type=urn:ietf:params:oauth:grant-type:device_code" & "&" &
"client_id=" & OAuthClientId & "&" &
"device_code=" & DeviceCode & "&" &
"scope=XboxLive.signin%20offline_access",
"application/x-www-form-urlencoded", 5000 + UnknownFailureCount * 5000, MakeLog:=False)
'获取结果
Dim ResultJson As JObject = GetJson(Result)
McLaunchLog($"令牌过期时间:{ResultJson("expires_in")} 秒")
Hint("网页登录成功!", HintType.Finish)
Finished({ResultJson("access_token").ToString, ResultJson("refresh_token").ToString})
Return
Catch ex As Exception
If ex.Message.Contains("authorization_declined") Then
Finished(New Exception("$你拒绝了 PCL 申请的权限……"))
Return
ElseIf ex.Message.Contains("expired_token") Then
Finished(New Exception("$登录用时太长啦,重新试试吧!"))
Return
ElseIf ex.Message.Contains("AADSTS70000") Then '可能不能判 “invalid_grant”,见 #269
Finished(New RestartException)
Return
ElseIf ex.Message.Contains("authorization_pending") Then
Thread.Sleep(2000)
ElseIf UnknownFailureCount <= 2 Then
UnknownFailureCount += 1
Log(ex, $"登录轮询第 {UnknownFailureCount} 次失败")
Thread.Sleep(2000)
Else
Finished(New Exception("登录轮询失败", ex))
Return
End If
End Try
Loop
End Sub
End Class
@@ -52,7 +52,7 @@
Exit Sub Exit Sub
End If End If
Try Try
Dim FileAddress As String = SelectAs("选取保存皮肤的位置", GetFileNameFromPath(Address), "皮肤图片文件(*.png)|*.png") Dim FileAddress As String = SelectSaveFile("选取保存皮肤的位置", GetFileNameFromPath(Address), "皮肤图片文件(*.png)|*.png")
If FileAddress.Contains("\") Then If FileAddress.Contains("\") Then
File.Delete(FileAddress) File.Delete(FileAddress)
If Address.StartsWith(PathImage) Then If Address.StartsWith(PathImage) Then
@@ -177,8 +177,8 @@
Sub() Sub()
Try Try
'更新缓存 '更新缓存
WriteIni(PathTemp & "Cache\Skin\IndexMs.ini", Setup.Get("CacheMsUuid"), SkinAddress) WriteIni(PathTemp & "Cache\Skin\IndexMs.ini", Setup.Get("CacheMsV2Uuid"), SkinAddress)
Log(String.Format("[Skin] 已写入皮肤地址缓存 {0} -> {1}", Setup.Get("CacheMsUuid"), SkinAddress)) Log(String.Format("[Skin] 已写入皮肤地址缓存 {0} -> {1}", Setup.Get("CacheMsV2Uuid"), SkinAddress))
'刷新控件 '刷新控件
For Each SkinLoader In {PageLaunchLeft.SkinMs, PageLaunchLeft.SkinLegacy} For Each SkinLoader In {PageLaunchLeft.SkinMs, PageLaunchLeft.SkinLegacy}
SkinLoader.WaitForExit(IsForceRestart:=True) SkinLoader.WaitForExit(IsForceRestart:=True)
@@ -242,7 +242,8 @@ Retry:
{"Vanilla", "原版披风"}, {"Minecon2011", "Minecon 2011 参与者披风"}, {"Minecon2012", "Minecon 2012 参与者披风"}, {"Vanilla", "原版披风"}, {"Minecon2011", "Minecon 2011 参与者披风"}, {"Minecon2012", "Minecon 2012 参与者披风"},
{"Minecon2013", "Minecon 2013 参与者披风"}, {"Minecon2015", "Minecon 2015 参与者披风"}, {"Minecon2016", "Minecon 2016 参与者披风"}, {"Minecon2013", "Minecon 2013 参与者披风"}, {"Minecon2015", "Minecon 2015 参与者披风"}, {"Minecon2016", "Minecon 2016 参与者披风"},
{"Cherry Blossom", "樱花披风"}, {"15th Anniversary", "15 周年纪念披风"}, {"Purple Heart", "紫色心形披风"}, {"Cherry Blossom", "樱花披风"}, {"15th Anniversary", "15 周年纪念披风"}, {"Purple Heart", "紫色心形披风"},
{"Follower's", "追随者披风"}, {"MCC 15th Year", "MCC 15 周年披风"} {"Follower's", "追随者披风"}, {"MCC 15th Year", "MCC 15 周年披风"}, {"Minecraft Experience", "村民救援披风"},
{"Mojang Office", "Mojang 办公室披风"}, {"Home", "家园披风"}, {"Menace", "入侵披风"}, {"Yearn", "渴望披风"}
} }
Dim SelectionControl As New List(Of IMyRadio) From {New MyRadioBox With {.Text = "无披风"}} Dim SelectionControl As New List(Of IMyRadio) From {New MyRadioBox With {.Text = "无披风"}}
For Each Cape In SkinData("capes") For Each Cape In SkinData("capes")
@@ -26,21 +26,15 @@
If File.Exists(Path & "modpack.zip") Then PackInstallPath = Path & "modpack.zip" If File.Exists(Path & "modpack.zip") Then PackInstallPath = Path & "modpack.zip"
If File.Exists(Path & "modpack.mrpack") Then PackInstallPath = Path & "modpack.mrpack" If File.Exists(Path & "modpack.mrpack") Then PackInstallPath = Path & "modpack.mrpack"
If PackInstallPath IsNot Nothing Then If PackInstallPath IsNot Nothing Then
If MyMsgBox($"PCL 即将在当前文件夹下自动安装整合包。", "自动安装", "继续", "取消") = 1 Then Log("[Launch] 需自动安装整合包:" & PackInstallPath, LogLevel.Debug)
'确认自动安装 Setup.Set("LaunchFolderSelect", "$.minecraft\")
Log("[Launch] 需自动安装整合包:" & PackInstallPath, LogLevel.Debug) If Not Directory.Exists(Path & ".minecraft\") Then
Setup.Set("LaunchFolderSelect", "$.minecraft\") Directory.CreateDirectory(Path & ".minecraft\")
If Not Directory.Exists(Path & ".minecraft\") Then Directory.CreateDirectory(Path & ".minecraft\versions\")
Directory.CreateDirectory(Path & ".minecraft\") McFolderLauncherProfilesJsonCreate(Path & ".minecraft\")
Directory.CreateDirectory(Path & ".minecraft\versions\")
McFolderLauncherProfilesJsonCreate(Path & ".minecraft\")
End If
McFolderListLoader.WaitForExit(IsForceRestart:=True)
Else
'取消自动安装
Log("[Launch] 取消自动安装整合包:" & PackInstallPath, LogLevel.Debug)
PackInstallPath = Nothing
End If End If
PageSelectLeft.AddFolder(Path & ".minecraft\", GetFolderNameFromPath(Path), False)
McFolderListLoader.WaitForExit()
End If End If
'确认 Minecraft 文件夹存在 '确认 Minecraft 文件夹存在
PathMcFolder = Setup.Get("LaunchFolderSelect").ToString.Replace("$", Path) PathMcFolder = Setup.Get("LaunchFolderSelect").ToString.Replace("$", Path)
@@ -58,18 +52,19 @@
If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(500, 3000)) If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(500, 3000))
'自动整合包安装 '自动整合包安装
If PackInstallPath IsNot Nothing Then If PackInstallPath IsNot Nothing Then
Dim InstallLoader = ModpackInstall(PackInstallPath) Try
If InstallLoader Is Nothing Then Dim InstallLoader = ModpackInstall(PackInstallPath)
Log("[Launch] 自动安装整合包失败:" & PackInstallPath) Log("[Launch] 自动安装整合包已开始:" & PackInstallPath)
Else
Log("[Launch] 自动安装整合包开始:" & PackInstallPath)
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
InstallLoader.WaitForExit() InstallLoader.WaitForExit()
If InstallLoader.State = LoadState.Finished Then If InstallLoader.State = LoadState.Finished Then
Log("[Launch] 自动安装整合包成功,删除安装包:" & PackInstallPath) Log("[Launch] 自动安装整合包成功,清理安装包:" & PackInstallPath)
File.Delete(PackInstallPath) If File.Exists(PackInstallPath) Then File.Delete(PackInstallPath)
End If End If
End If Catch ex As CancelledException
Log(ex, "自动安装整合包被用户取消:" & PackInstallPath)
Catch ex As Exception
Log(ex, "自动安装整合包失败:" & PackInstallPath, LogLevel.Msgbox)
End Try
End If End If
'确认 Minecraft 版本存在 '确认 Minecraft 版本存在
Dim Selection As String = Setup.Get("LaunchVersionSelect") Dim Selection As String = Setup.Get("LaunchVersionSelect")
@@ -130,7 +125,7 @@
'初始化页面 '初始化页面
LabLaunchingName.Text = McVersionCurrent.Name LabLaunchingName.Text = McVersionCurrent.Name
LabLaunchingStage.Text = "初始化" LabLaunchingStage.Text = "初始化"
LabLaunchingTitle.Text = If(McLaunchLoader.Input Is Nothing OrElse McLaunchLoader.Input.SaveBatch Is Nothing, "正在启动游戏", "正在导出启动脚本") LabLaunchingTitle.Text = If(CurrentLaunchOptions?.SaveBatch Is Nothing, "正在启动游戏", "正在导出启动脚本")
LabLaunchingProgress.Text = "0.00 %" LabLaunchingProgress.Text = "0.00 %"
LabLaunchingProgress.Opacity = 1 LabLaunchingProgress.Opacity = 1
LabLaunchingDownload.Visibility = Visibility.Visible LabLaunchingDownload.Visibility = Visibility.Visible
@@ -296,7 +291,7 @@
Case 0 '正版或离线 Case 0 '正版或离线
UnknownType: UnknownType:
If RadioLoginType5.Checked Then If RadioLoginType5.Checked Then
If Setup.Get("CacheMsAccess") = "" Then If Setup.Get("CacheMsV2Access") = "" Then
Type = PageType.Ms Type = PageType.Ms
Else Else
Type = PageType.MsSkin Type = PageType.MsSkin
@@ -311,7 +306,7 @@ UnknownType:
RadioLoginType5.Visibility = Visibility.Visible RadioLoginType5.Visibility = Visibility.Visible
RadioLoginType0.Visibility = Visibility.Visible RadioLoginType0.Visibility = Visibility.Visible
Case 1 '仅正版 Case 1 '仅正版
If Setup.Get("CacheMsAccess") = "" Then If Setup.Get("CacheMsV2Access") = "" Then
Type = PageType.Ms Type = PageType.Ms
Else Else
Type = PageType.MsSkin Type = PageType.MsSkin
@@ -375,7 +370,7 @@ UnknownType:
Public Shared SkinMs As New LoaderTask(Of EqualableList(Of String), String)("Loader Skin Ms", AddressOf SkinMsLoad, AddressOf SkinMsInput, ThreadPriority.AboveNormal) Public Shared SkinMs As New LoaderTask(Of EqualableList(Of String), String)("Loader Skin Ms", AddressOf SkinMsLoad, AddressOf SkinMsInput, ThreadPriority.AboveNormal)
Private Shared Function SkinMsInput() As EqualableList(Of String) Private Shared Function SkinMsInput() As EqualableList(Of String)
'获取名称 '获取名称
Return New EqualableList(Of String) From {Setup.Get("CacheMsName"), Setup.Get("CacheMsUuid")} Return New EqualableList(Of String) From {Setup.Get("CacheMsV2Name"), Setup.Get("CacheMsV2Uuid")}
End Function End Function
Private Shared Sub SkinMsLoad(Data As LoaderTask(Of EqualableList(Of String), String)) Private Shared Sub SkinMsLoad(Data As LoaderTask(Of EqualableList(Of String), String))
'清空已有皮肤 '清空已有皮肤
@@ -431,7 +426,7 @@ Finish:
ElseIf Setup.Get("LoginLegacyName") = "" Then ElseIf Setup.Get("LoginLegacyName") = "" Then
Return New EqualableList(Of String) From {0, ""} Return New EqualableList(Of String) From {0, ""}
Else Else
Return New EqualableList(Of String) From {0, If(Setup.Get("LoginLegacyName").ToString.Before("¨"), "")} Return New EqualableList(Of String) From {0, If(Setup.Get("LoginLegacyName").ToString.BeforeFirst("¨"), "")}
End If End If
Case 3 Case 3
Return New EqualableList(Of String) From {3, Setup.Get("LaunchSkinID")} Return New EqualableList(Of String) From {3, Setup.Get("LaunchSkinID")}
@@ -733,7 +728,7 @@ ExitRefresh:
If ActualProgress <= ShowProgress Then ShowProgress = ActualProgress '原来或处理后变得比实际进度高,直接回退 If ActualProgress <= ShowProgress Then ShowProgress = ActualProgress '原来或处理后变得比实际进度高,直接回退
If IsLaunched Then ShowProgress = 1 '如果已经完成了,就不卖关子了 If IsLaunched Then ShowProgress = 1 '如果已经完成了,就不卖关子了
'文本 '文本
LabLaunchingTitle.Text = If(IsLaunched, "已启动游戏", If(McLaunchLoader.Input.SaveBatch Is Nothing, "正在启动游戏", "正在导出启动脚本")) LabLaunchingTitle.Text = If(IsLaunched, "已启动游戏", If(CurrentLaunchOptions.SaveBatch Is Nothing, "正在启动游戏", "正在导出启动脚本"))
LabLaunchingProgress.Text = StrFillNum(ShowProgress * 100, 2) & " %" LabLaunchingProgress.Text = StrFillNum(ShowProgress * 100, 2) & " %"
Dim HasLaunchDownloader As Boolean = False Dim HasLaunchDownloader As Boolean = False
Try Try
@@ -1,4 +1,5 @@
Public Class PageLaunchRight Public Class PageLaunchRight
Implements IRefreshable
Private Sub Init() Handles Me.Loaded Private Sub Init() Handles Me.Loaded
PanBack.ScrollToHome() PanBack.ScrollToHome()
@@ -92,7 +93,7 @@ Download:
GoTo Download GoTo Download
Case 3 Case 3
Log("[Page] 主页预设:简单主页") Log("[Page] 主页预设:简单主页")
Url = "https://gitee.com/mfn233/PCL-Mainpage/raw/main/Custom.xaml" Url = "https://raw.gitcode.com/mfn233/PCL-Mainpage/raw/main/Custom.xaml"
GoTo Download GoTo Download
Case 4 Case 4
Log("[Page] 主页预设:每日整合包推荐") Log("[Page] 主页预设:每日整合包推荐")
@@ -104,7 +105,27 @@ Download:
GoTo Download GoTo Download
Case 6 Case 6
Log("[Page] 主页预设:OpenBMCLAPI 仪表盘 Lite") Log("[Page] 主页预设:OpenBMCLAPI 仪表盘 Lite")
Url = "https://pcl-bmcl.milulu.xyz/" Url = "https://pcl-bmcl.milu.ink/"
GoTo Download
Case 7
Log("[Page] 主页预设:主页市场")
Url = "https://pclhomeplazaoss.lingyunawa.top:26994/d/Homepages/JingHai-Lingyun/Custom.xaml"
GoTo Download
Case 8
Log("[Page] 主页预设:更新日志")
Url = "https://pclhomeplazaoss.lingyunawa.top:26994/d/Homepages/Joker2184/UpdateHomepage.xaml"
GoTo Download
Case 9
Log("[Page] 主页预设:PCL 新功能说明书")
Url = "https://raw.gitcode.com/WForst-Breeze/WhatsNewPCL/raw/main/Custom.xaml"
GoTo Download
Case 10
Log("[Page] 主页预设:OpenMCIM Dashboard")
Url = "https://files.mcimirror.top/PCL"
GoTo Download
Case 11
Log("[Page] 主页预设:杂志主页")
Url = "https://pclhomeplazaoss.lingyunawa.top:26994/d/Homepages/Ext1nguisher/Custom.xaml"
GoTo Download GoTo Download
End Select End Select
End Select End Select
@@ -122,17 +143,17 @@ Download:
If Address.Contains(".xaml") Then If Address.Contains(".xaml") Then
VersionAddress = Address.Replace(".xaml", ".xaml.ini") VersionAddress = Address.Replace(".xaml", ".xaml.ini")
Else Else
VersionAddress = Address.Before("?") VersionAddress = Address.BeforeFirst("?")
If Not VersionAddress.EndsWith("/") Then VersionAddress += "/" If Not VersionAddress.EndsWith("/") Then VersionAddress += "/"
VersionAddress += "version" VersionAddress += "version"
If Address.Contains("?") Then VersionAddress += Address.After("?") If Address.Contains("?") Then VersionAddress += Address.AfterLast("?")
End If End If
'校验版本 '校验版本
Dim Version As String = "" Dim Version As String = ""
Dim NeedDownload As Boolean = True Dim NeedDownload As Boolean = True
Try Try
Version = NetGetCodeByRequestOnce(VersionAddress, Timeout:=10000) Version = NetGetCodeByRequestOnce(VersionAddress, Timeout:=10000)
If Version.Length > 100 Then Throw New Exception($"获取的自定义主页版本过长({Version.Length} 字符)") If Version.Length > 1000 Then Throw New Exception($"获取的自定义主页版本过长({Version.Length} 字符)")
Dim CurrentVersion As String = Setup.Get("CacheSavedPageVersion") Dim CurrentVersion As String = Setup.Get("CacheSavedPageVersion")
If Version <> "" AndAlso CurrentVersion <> "" AndAlso Version = CurrentVersion Then If Version <> "" AndAlso CurrentVersion <> "" AndAlso Version = CurrentVersion Then
Log($"[Page] 当前缓存的自定义主页已为最新,当前版本:{Version},检查源:{VersionAddress}") Log($"[Page] 当前缓存的自定义主页已为最新,当前版本:{Version},检查源:{VersionAddress}")
@@ -167,7 +188,7 @@ Download:
''' 立即强制刷新自定义主页。 ''' 立即强制刷新自定义主页。
''' 必须在 UI 线程调用。 ''' 必须在 UI 线程调用。
''' </summary> ''' </summary>
Public Sub ForceRefresh() Public Sub ForceRefresh() Implements IRefreshable.Refresh
Log("[Page] 要求强制刷新自定义主页") Log("[Page] 要求强制刷新自定义主页")
ClearCache() ClearCache()
'实际的刷新 '实际的刷新
@@ -206,14 +227,20 @@ Download:
Log($"[Page] 实例化:清空自定义主页 UI,来源为空") Log($"[Page] 实例化:清空自定义主页 UI,来源为空")
Return Return
End If End If
Content = "<StackPanel xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" xmlns:x=""http://schemas.microsoft.com/winfx/2006/xaml"" xmlns:local=""clr-namespace:PCL;assembly=Plain Craft Launcher 2"">" & Content & "</StackPanel>"
Content = HelpArgumentReplace(Content)
Log($"[Page] 实例化:加载自定义主页 UI 开始,最终内容长度:{Content.Count}")
Try Try
Content = HelpArgumentReplace(Content)
If Content.Contains("xmlns") Then Content = Content.RegexReplace("xmlns[^""']*(""|')[^""']*(""|')", "").Replace("xmlns", "") '禁止声明命名空间
Content = "<StackPanel xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" xmlns:sys=""clr-namespace:System;assembly=mscorlib"" xmlns:x=""http://schemas.microsoft.com/winfx/2006/xaml"" xmlns:local=""clr-namespace:PCL;assembly=Plain Craft Launcher 2"">" & Content & "</StackPanel>"
Log($"[Page] 实例化:加载自定义主页 UI 开始,最终内容长度:{Content.Count}")
PanCustom.Children.Add(GetObjectFromXML(Content)) PanCustom.Children.Add(GetObjectFromXML(Content))
Catch ex As UnauthorizedAccessException
Log(ex, "加载失败的自定义主页内容:" & vbCrLf & Content)
If MyMsgBox(ex.Message, "加载自定义主页失败", "重试", "取消") = 1 Then
GoTo Refresh '防止 SyncLock 死锁
End If
Catch ex As Exception Catch ex As Exception
Log("[Page] 加载失败的自定义主页内容:" & vbCrLf & Content) Log(ex, "加载失败的自定义主页内容:" & vbCrLf & Content)
If MyMsgBox($"自定义主页内容编写有误,请根据下列错误信息进行检查:{vbCrLf}{ex.Message}", "加载自定义主页失败", "重试", "取消") = 1 Then If MyMsgBox($"自定义主页内容编写有误,请根据下列错误信息进行检查:{vbCrLf}{GetExceptionSummary(ex)}", "加载自定义主页失败", "重试", "取消") = 1 Then
GoTo Refresh '防止 SyncLock 死锁 GoTo Refresh '防止 SyncLock 死锁
End If End If
End Try End Try
@@ -17,8 +17,8 @@
ComboName.ItemsSource = Nothing ComboName.ItemsSource = Nothing
Else Else
ComboName.ItemsSource = Setup.Get("LoginAuthEmail").ToString.Split("¨") ComboName.ItemsSource = Setup.Get("LoginAuthEmail").ToString.Split("¨")
ComboName.Text = Setup.Get("LoginAuthEmail").ToString.Before("¨") ComboName.Text = Setup.Get("LoginAuthEmail").ToString.BeforeFirst("¨")
If Setup.Get("LoginRemember") Then TextPass.Password = Setup.Get("LoginAuthPass").ToString.Before("¨").Trim If Setup.Get("LoginRemember") Then TextPass.Password = Setup.Get("LoginAuthPass").ToString.BeforeFirst("¨").Trim
End If End If
End If End If
IsFirstLoad = False IsFirstLoad = False
@@ -70,9 +70,11 @@
End Try End Try
End Sub) End Sub)
End Sub End Sub
Private Sub BtnExit_Click() Handles BtnExit.Click Public Shared Sub ExitLogin() Handles BtnExit.Click
Setup.Set("CacheAuthAccess", "") Setup.Set("CacheAuthAccess", "")
Setup.Set("CacheAuthUuid", "") Setup.Set("CacheAuthUuid", "")
Setup.Set("CacheAuthName", "")
McLoginAuthLoader.Input = Nothing '防止因为输入的用户名密码相同,直接使用了上次登录的加载器结果
FrmLaunchLeft.RefreshPage(False, True) FrmLaunchLeft.RefreshPage(False, True)
End Sub End Sub
@@ -26,7 +26,7 @@ Public Class PageLoginLegacy
ComboName.ItemsSource = Nothing ComboName.ItemsSource = Nothing
Else Else
ComboName.ItemsSource = Setup.Get("LoginLegacyName").ToString.Split("¨") ComboName.ItemsSource = Setup.Get("LoginLegacyName").ToString.Split("¨")
ComboName.Text = Setup.Get("LoginLegacyName").ToString.Before("¨").Trim ComboName.Text = Setup.Get("LoginLegacyName").ToString.BeforeFirst("¨").Trim
End If End If
End If End If
IsReloaded = True IsReloaded = True
@@ -44,6 +44,11 @@ Public Class PageLoginLegacy
Public Shared Function IsVaild(LoginData As McLoginLegacy) As String Public Shared Function IsVaild(LoginData As McLoginLegacy) As String
If LoginData.UserName.Trim = "" Then Return "玩家名不能为空!" If LoginData.UserName.Trim = "" Then Return "玩家名不能为空!"
If LoginData.UserName.Contains("""") Then Return "玩家名不能包含英文引号!" If LoginData.UserName.Contains("""") Then Return "玩家名不能包含英文引号!"
If McVersionCurrent IsNot Nothing AndAlso
((McVersionCurrent.Version.McCodeMain = 20 AndAlso McVersionCurrent.Version.McCodeSub >= 3) OrElse McVersionCurrent.Version.McCodeMain > 20) AndAlso
LoginData.UserName.Trim.Length > 16 Then
Return "自 1.20.3 起,玩家名至多只能包含 16 个字符!"
End If
Return "" Return ""
End Function End Function
Public Function IsVaild() As String Public Function IsVaild() As String
@@ -37,7 +37,7 @@
''' 获取当前页面的登录信息。 ''' 获取当前页面的登录信息。
''' </summary> ''' </summary>
Public Shared Function GetLoginData() As McLoginMs Public Shared Function GetLoginData() As McLoginMs
If FrmLoginMs Is Nothing Then Return New McLoginMs With {.OAuthRefreshToken = Setup.Get("CacheMsOAuthRefresh"), .UserName = Setup.Get("CacheMsName")} If FrmLoginMs Is Nothing Then Return New McLoginMs With {.OAuthRefreshToken = Setup.Get("CacheMsV2OAuthRefresh"), .UserName = Setup.Get("CacheMsV2Name")}
Dim Result As McLoginMs = Nothing Dim Result As McLoginMs = Nothing
RunInUiWait( RunInUiWait(
Sub() Sub()
@@ -92,7 +92,7 @@
ElseIf ex.Message.StartsWith("$") Then ElseIf ex.Message.StartsWith("$") Then
Hint(ex.Message.TrimStart("$"), HintType.Critical) Hint(ex.Message.TrimStart("$"), HintType.Critical)
ElseIf TypeOf ex Is Security.Authentication.AuthenticationException AndAlso ex.Message.ContainsF("SSL/TLS") Then ElseIf TypeOf ex Is Security.Authentication.AuthenticationException AndAlso ex.Message.ContainsF("SSL/TLS") Then
Log(ex, "正版登录验证失败,请尝试在 [设置 → 启动器] 中关闭 [验证 SSL 证书] 然后再试。" & vbCrLf & vbCrLf & "原始错误信息:", LogLevel.Msgbox) Log(ex, "正版登录验证失败,请考虑在 [设置 → 其他] 中关闭 [在正版登录时验证 SSL 证书],然后再试。" & vbCrLf & vbCrLf & "原始错误信息:", LogLevel.Msgbox)
Else Else
Log(ex, "正版登录尝试失败", LogLevel.Msgbox) Log(ex, "正版登录尝试失败", LogLevel.Msgbox)
End If End If
@@ -12,7 +12,7 @@
''' 刷新页面显示的所有信息。 ''' 刷新页面显示的所有信息。
''' </summary> ''' </summary>
Public Sub Reload(KeepInput As Boolean) Public Sub Reload(KeepInput As Boolean)
TextName.Text = Setup.Get("CacheMsName") TextName.Text = Setup.Get("CacheMsV2Name")
'皮肤在 Loaded 加载 '皮肤在 Loaded 加载
End Sub End Sub
''' <summary> ''' <summary>
@@ -20,9 +20,9 @@
''' </summary> ''' </summary>
Public Shared Function GetLoginData() As McLoginMs Public Shared Function GetLoginData() As McLoginMs
If McLoginMsLoader.State = LoadState.Finished Then If McLoginMsLoader.State = LoadState.Finished Then
Return New McLoginMs With {.OAuthRefreshToken = Setup.Get("CacheMsOAuthRefresh"), .UserName = Setup.Get("CacheMsName"), .AccessToken = Setup.Get("CacheMsAccess"), .Uuid = Setup.Get("CacheMsUuid"), .ProfileJson = Setup.Get("CacheMsProfileJson")} Return New McLoginMs With {.OAuthRefreshToken = Setup.Get("CacheMsV2OAuthRefresh"), .UserName = Setup.Get("CacheMsV2Name"), .AccessToken = Setup.Get("CacheMsV2Access"), .Uuid = Setup.Get("CacheMsV2Uuid"), .ProfileJson = Setup.Get("CacheMsV2ProfileJson")}
Else Else
Return New McLoginMs With {.OAuthRefreshToken = Setup.Get("CacheMsOAuthRefresh"), .UserName = Setup.Get("CacheMsName")} Return New McLoginMs With {.OAuthRefreshToken = Setup.Get("CacheMsV2OAuthRefresh"), .UserName = Setup.Get("CacheMsV2Name")}
End If End If
End Function End Function
@@ -50,11 +50,11 @@
'退出登录 '退出登录
Private Sub BtnExit_Click() Handles BtnExit.Click Private Sub BtnExit_Click() Handles BtnExit.Click
Setup.Set("CacheMsOAuthRefresh", "") Setup.Set("CacheMsV2OAuthRefresh", "")
Setup.Set("CacheMsAccess", "") Setup.Set("CacheMsV2Access", "")
Setup.Set("CacheMsProfileJson", "") Setup.Set("CacheMsV2ProfileJson", "")
Setup.Set("CacheMsUuid", "") Setup.Set("CacheMsV2Uuid", "")
Setup.Set("CacheMsName", "") Setup.Set("CacheMsV2Name", "")
McLoginMsLoader.Abort() McLoginMsLoader.Abort()
FrmLaunchLeft.RefreshPage(False, True) FrmLaunchLeft.RefreshPage(False, True)
End Sub End Sub
@@ -90,8 +90,8 @@
Try Try
Retry: Retry:
If McLoginMsLoader.State = LoadState.Loading Then McLoginMsLoader.WaitForExit() '等待登录结束 If McLoginMsLoader.State = LoadState.Loading Then McLoginMsLoader.WaitForExit() '等待登录结束
Dim AccessToken As String = Setup.Get("CacheMsAccess") Dim AccessToken As String = Setup.Get("CacheMsV2Access")
Dim Uuid As String = Setup.Get("CacheMsUuid") Dim Uuid As String = Setup.Get("CacheMsV2Uuid")
Dim Client As New Net.Http.HttpClient With {.Timeout = New TimeSpan(0, 0, 30)} Dim Client As New Net.Http.HttpClient With {.Timeout = New TimeSpan(0, 0, 30)}
Client.DefaultRequestHeaders.Authorization = New Net.Http.Headers.AuthenticationHeaderValue("Bearer", AccessToken) Client.DefaultRequestHeaders.Authorization = New Net.Http.Headers.AuthenticationHeaderValue("Bearer", AccessToken)
@@ -113,6 +113,7 @@ Retry:
'获取新皮肤地址 '获取新皮肤地址
Log("[Skin] 皮肤修改返回值:" & vbCrLf & Result) Log("[Skin] 皮肤修改返回值:" & vbCrLf & Result)
Dim ResultJson As JObject = GetJson(Result) Dim ResultJson As JObject = GetJson(Result)
If ResultJson.ContainsKey("errorMessage") Then Throw New Exception(ResultJson("errorMessage").ToString) '#5309
For Each Skin As JObject In ResultJson("skins") For Each Skin As JObject In ResultJson("skins")
If Skin("state").ToString = "ACTIVE" Then If Skin("state").ToString = "ACTIVE" Then
MySkin.ReloadCache(Skin("url")) MySkin.ReloadCache(Skin("url"))
@@ -17,8 +17,8 @@
ComboName.ItemsSource = Nothing ComboName.ItemsSource = Nothing
Else Else
ComboName.ItemsSource = Setup.Get("LoginNideEmail").ToString.Split("¨") ComboName.ItemsSource = Setup.Get("LoginNideEmail").ToString.Split("¨")
ComboName.Text = Setup.Get("LoginNideEmail").ToString.Before("¨") ComboName.Text = Setup.Get("LoginNideEmail").ToString.BeforeFirst("¨")
If Setup.Get("LoginRemember") Then TextPass.Password = Setup.Get("LoginNidePass").ToString.Before("¨").Trim If Setup.Get("LoginRemember") Then TextPass.Password = Setup.Get("LoginNidePass").ToString.BeforeFirst("¨").Trim
End If End If
End If End If
IsFirstLoad = False IsFirstLoad = False
@@ -47,8 +47,9 @@
Private Sub BtnEdit_Click(sender As Object, e As EventArgs) Handles BtnEdit.Click Private Sub BtnEdit_Click(sender As Object, e As EventArgs) Handles BtnEdit.Click
OpenWebsite("https://login.mc-user.com:233/account/changepw") OpenWebsite("https://login.mc-user.com:233/account/changepw")
End Sub End Sub
Private Sub BtnExit_Click() Handles BtnExit.Click Public Shared Sub ExitLogin() Handles BtnExit.Click
Setup.Set("CacheNideAccess", "") Setup.Set("CacheNideAccess", "")
McLoginNideLoader.Input = Nothing '防止因为输入的用户名密码相同,直接使用了上次登录的加载器结果
FrmLaunchLeft.RefreshPage(False, True) FrmLaunchLeft.RefreshPage(False, True)
End Sub End Sub
@@ -17,7 +17,7 @@
Private IsLoad As Boolean = False Private IsLoad As Boolean = False
Private Sub OnLoaded() Handles Me.Loaded Private Sub OnLoaded() Handles Me.Loaded
FormMain.EndProgramForce(Result.Aborted) FormMain.EndProgramForce(ProcessReturnValues.Aborted)
If IsLoad Then Exit Sub If IsLoad Then Exit Sub
IsLoad = True IsLoad = True
'启动监视线程 '启动监视线程
@@ -111,8 +111,6 @@ Public Class PageLinkIoi
End Sub End Sub
'复制联机码 '复制联机码
Public Shared Sub BtnLeftCopy_Click() Handles BtnLeftCopy.Click Public Shared Sub BtnLeftCopy_Click() Handles BtnLeftCopy.Click
ClipboardSet(IoiId.Substring(4) & SecretEncrypt(GetPlayerName), False)
Hint("已复制联机码!", HintType.Finish)
End Sub End Sub
#End Region #End Region
@@ -419,75 +417,6 @@ Public Class PageLinkIoi
'获取数据包 '获取数据包
Public Shared Sub ReceiveJson(JsonData As JObject, Optional NewSocket As Socket = Nothing) Public Shared Sub ReceiveJson(JsonData As JObject, Optional NewSocket As Socket = Nothing)
'获取数据
Dim Id As String = JsonData("id"), Type As String = JsonData("type")
Select Case Type
Case "connect"
Dim DisplayName As String = JsonData("name")
Dim User As New LinkUserIoi(Id, DisplayName, NewSocket)
'如果发生了双向连接
If UserList.ContainsKey(Id) Then
If Id > IoiId Then
Log("[IOI] 双向连接,应当抛弃当前用户(" & DisplayName & ")")
For Each Pair In UserList(User.Id).Ports.ToList
User.Ports(Pair.Key) = Pair.Value
Next
UserList(Id).Dispose()
Else
'应当保留当前用户
Log("[IOI] 双向连接,应当保留当前用户(" & DisplayName & ")")
NewSocket.Dispose()
Exit Sub
End If
End If
'加入列表
UserList.Add(Id, User)
'返回请求
User.RelativeThread = RunInNewThread(Sub()
SendPortsubBack(User, JsonData("version").ToObject(Of Integer))
End Sub, "Link Connect " & DisplayName)
'更新时间
User.LastReceive = Date.Now
Case "update"
If Not UserList.ContainsKey(Id) Then Throw New Exception("未在列表中的用户发送了更新请求:" & Id)
Dim User = UserList(Id)
'拉满进度(该请求也作为反向连接回应出现,用于向正向连接方传达连接已完成信号)
User.Progress = 1
'更新名称
Dim DisplayName As String = JsonData("name")
User.DisplayName = DisplayName
'更新房间列表
If JsonData("rooms") IsNot Nothing Then
User.Rooms = New List(Of RoomEntry)
For Each RoomObject In JsonData("rooms")
User.Rooms.Add(New RoomEntry(RoomObject("port"), RoomObject("name"), User))
Next
End If
'更新 Ping
Dim Stage As Integer = JsonData("stage"), Unique As Long = JsonData("unique")
If Stage > 1 Then
User.PingRecord.Enqueue((Date.Now - User.PingPending(Unique)).TotalMilliseconds / 2)
If User.PingRecord.Count > 5 Then User.PingRecord.Dequeue()
User.PingPending.Remove(Unique)
End If
'返回请求
If Stage > 0 AndAlso Stage < 3 Then RunInNewThread(Sub()
Try
SendUpdateRequest(User, Stage + 1, Unique)
Catch ex As Exception
Log(ex, "发送回程请求失败")
End Try
End Sub, "Link Update " & DisplayName)
'更新时间
User.LastReceive = Date.Now
Case "disconnect"
'断开连接
If Not UserList.ContainsKey(Id) Then Exit Sub
UserRemove(UserList(Id), ShowLeaveMessage:=JsonData("message") Is Nothing)
If JsonData("message") IsNot Nothing Then Hint(JsonData("message").ToString, If(JsonData("isError").ToObject(Of Boolean), HintType.Critical, HintType.Info))
Case Else
Throw New Exception("未知的操作种类:" & Type)
End Select
End Sub End Sub
''' <summary> ''' <summary>
''' 从用户列表中移除一位用户。提示信息视作该用户主动离开。 ''' 从用户列表中移除一位用户。提示信息视作该用户主动离开。

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