InfStarMC/PCL-ISE
1
0
Fork 0
Code Issues Pull Requests Actions 1 Packages Projects Releases Wiki Activity

Merge branch 'Hex-Dragon:main' into Server

Browse Source
This commit is contained in:
tangge233
2024-09-24 19:09:44 +08:00
committed by GitHub
parent c9fb9b9eea b5c9736918
commit ddb6ef9426
40 changed files with 949 additions and 764 deletions
Download Patch File Download Diff File Expand all files Collapse all files
.github/workflows/build.yml
+12 -15
View File
@@ -1,5 +1,4 @@
name: Build name: Build
on: on:
push: push:
paths: paths:
@@ -12,37 +11,35 @@ 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:
fetch-depth: 0 fetch-depth: 0
- 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: 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
Plain Craft Launcher 2/Application.xaml.vb
+15 -15
View File
@@ -96,23 +96,20 @@ 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} ({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")
@@ -177,11 +174,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 +206,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(PathTemp)
File.WriteAllBytes(PathTemp & "libwebp.dll", GetResources("libwebp64"))
End If End If
Return AssemblyWebp Return AssemblyImazenWebp
End SyncLock End SyncLock
Else Else
Return Nothing Return Nothing
Plain Craft Launcher 2/Controls/MyIconTextButton.xaml.vb
+4 -4
View File
@@ -46,18 +46,18 @@
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))
'点击事件 '点击事件
Plain Craft Launcher 2/FormMain.xaml
+1 -1
View File
@@ -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" />
Plain Craft Launcher 2/FormMain.xaml.vb
+25 -12
View File
@@ -134,6 +134,14 @@ Public Class FormMain
'3：BUG+ IMP* FEAT- '3：BUG+ IMP* FEAT-
'2：BUG* IMP- '2：BUG* IMP-
'1：BUG- '1：BUG-
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 的图标的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复在 Mod 管理页面删除 Mod 导致报错的 Bug"))
FeatureCount += 11
BugCount += 21
End If
If LastVersion < 335 Then 'Snapshot 2.8.6 If LastVersion < 335 Then 'Snapshot 2.8.6
BugCount += 2 BugCount += 2
End If End If
@@ -432,6 +440,10 @@ Public Class FormMain
Height = MinHeight + 50 Height = MinHeight + 50
Width = MinWidth + 50 Width = MinWidth + 50
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))
'更改窗口 '更改窗口
@@ -1011,18 +1023,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
Plain Craft Launcher 2/Images/Icons/Unavaliable.png → Plain Craft Launcher 2/Images/Icons/Unavailable.png
View File
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 2.2 KiB

After

Width:  |  Height:  |  Size: 2.2 KiB

Plain Craft Launcher 2/Modules/Base/ModBase.vb
+31 -13
View File
@@ -1,4 +1,5 @@
Imports System.IO.Compression Imports System.Globalization
Imports System.IO.Compression
Imports System.Runtime.CompilerServices Imports System.Runtime.CompilerServices
Imports System.Security.Cryptography Imports System.Security.Cryptography
Imports System.Security.Principal Imports System.Security.Principal
@@ -11,12 +12,13 @@ Public Module ModBase
#Region "声明" #Region "声明"
'下列版本信息由更新器自动修改 '下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.8.6" '不含分支前缀的显示用版本名 Public Const VersionBaseName As String = "2.8.7" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.8.6." & VersionBranchCode '标准格式的四段式版本号 Public Const VersionStandardCode As String = "2.8.7." & VersionBranchCode '标准格式的四段式版本号
Public Const CommitHash As String = "" 'Commit Hash，由 GitHub Workflow 自动替换
#If BETA Then #If BETA Then
Public Const VersionCode As Integer = 336 'Release Public Const VersionCode As Integer = 336 'Release
#Else #Else
Public Const VersionCode As Integer = 335 'Snapshot Public Const VersionCode As Integer = 337 'Snapshot
#End If #End If
'自动生成的版本信息 '自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -64,7 +66,7 @@ Public Module ModBase
''' </summary> ''' </summary>
Public ApplicationOpenTime As Date = Date.Now Public ApplicationOpenTime As Date = Date.Now
''' <summary> ''' <summary>
''' 设备唯一标识符。 ''' 识别码。
''' </summary> ''' </summary>
Public UniqueAddress As String = SecretGetUniqueAddress() Public UniqueAddress As String = SecretGetUniqueAddress()
''' <summary> ''' <summary>
@@ -1240,9 +1242,15 @@ Re:
Public Function DeleteDirectory(Path As String, Optional IgnoreIssue As Boolean = False) As Integer Public Function DeleteDirectory(Path As String, Optional IgnoreIssue As Boolean = False) As Integer
If Not Directory.Exists(Path) Then Return 0 If Not Directory.Exists(Path) Then Return 0
Dim DeletedCount As Integer = 0 Dim DeletedCount As Integer = 0
Dim Temp As String() Dim Files As String()
Temp = Directory.GetFiles(Path) Try
For Each FilePath As String In Temp Files = Directory.GetFiles(Path)
Catch ex As DirectoryNotFoundException '#4549
Log(ex, $"疑似为孤立符号链接，尝试直接删除（{Path}）", LogLevel.Developer)
Directory.Delete(Path)
Return 0
End Try
For Each FilePath As String In Files
Dim RetriedFile As Boolean = False Dim RetriedFile As Boolean = False
RetryFile: RetryFile:
Try Try
@@ -1261,8 +1269,7 @@ RetryFile:
End If End If
End Try End Try
Next Next
Temp = Directory.GetDirectories(Path) For Each str As String In Directory.GetDirectories(Path)
For Each str As String In Temp
DeleteDirectory(str, IgnoreIssue) DeleteDirectory(str, IgnoreIssue)
Next Next
Dim RetriedDir As Boolean = False Dim RetriedDir As Boolean = False
@@ -1444,14 +1451,14 @@ RetryDir:
End Function End Function
''' <summary> ''' <summary>
''' 获取 Json 对象。 ''' 获取 JSON 对象。
''' </summary> ''' </summary>
Public Function GetJson(Data As String) Public Function GetJson(Data As String)
Try Try
Return JsonConvert.DeserializeObject(Data, New JsonSerializerSettings With {.DateTimeZoneHandling = DateTimeZoneHandling.Local}) Return JsonConvert.DeserializeObject(Data, New JsonSerializerSettings With {.DateTimeZoneHandling = DateTimeZoneHandling.Local})
Catch ex As Exception Catch ex As Exception
Dim Length As Integer = If(Data, "").Length Dim Length As Integer = If(Data, "").Length
Throw New Exception("格式化 json 对象失败：" & If(Length > 10000, Data.Substring(0, 100) & $"...(全长 {Length} 个字符)..." & Right(Data, 100), Data)) Throw New Exception("格式化 JSON 失败：" & If(Length > 2000, Data.Substring(0, 500) & $"...(全长 {Length} 个字符)..." & Right(Data, 500), Data))
End Try End Try
End Function End Function
@@ -1855,6 +1862,13 @@ RetryDir:
Return NewProcess.ExitCode Return NewProcess.ExitCode
End Function End Function
''' <summary>
''' 判断当前系统语言是否为中文。
''' </summary>
Public Function IsSystemLanguageChinese() As Boolean
Return CultureInfo.CurrentCulture.TwoLetterISOLanguageName = "zh" OrElse CultureInfo.CurrentUICulture.TwoLetterISOLanguageName = "zh"
End Function
Private Uuid As Integer = 1 Private Uuid As Integer = 1
Private UuidLock As Object Private UuidLock As Object
''' <summary> ''' <summary>
@@ -2660,7 +2674,11 @@ Retry:
End Sub End Sub
Public Function CanFeedback(ShowHint As Boolean) As Boolean Public Function CanFeedback(ShowHint As Boolean) As Boolean
If False.Equals(PageSetupSystem.IsLauncherNewest) Then If False.Equals(PageSetupSystem.IsLauncherNewest) Then
If ShowHint Then MyMsgBox("你的 PCL 不是最新版，因此无法提交反馈。" & vbCrLf & "请先在 设置 → 启动器 中更新启动器，确认该问题在最新版中依然存在，然后再提交反馈。", "无法提交反馈") If ShowHint Then
If MyMsgBox($"你的 PCL 不是最新版，因此无法提交反馈。{vbCrLf}请在更新后，确认该问题在最新版中依然存在，然后再提交反馈。", "无法提交反馈", "更新", "取消") = 1 Then
UpdateCheckByButton()
End If
End If
Return False Return False
Else Else
Return True Return True
Plain Craft Launcher 2/Modules/Base/ModLoader.vb
+15 -14
View File
@@ -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
@@ -566,7 +567,7 @@ Restart:
End Class End Class
'任务栏进度条 '任务栏进度条
Public LoaderTaskbar As New Concurrent.ConcurrentBag(Of LoaderBase) Public LoaderTaskbar As New SynchronizedCollection(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 +583,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
Plain Craft Launcher 2/Modules/Base/ModNet.vb
+10 -7
View File
@@ -329,7 +329,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 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, 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 +338,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
@@ -1232,7 +1232,7 @@ SourceBreak:
'根据情况判断，是否在多线程下禁用下载源（连续错误过多，或不支持断点续传） '根据情况判断，是否在多线程下禁用下载源（连续错误过多，或不支持断点续传）
If ex.Message.Contains("该下载源不支持") OrElse ex.Message.Contains("未能解析") OrElse ex.Message.Contains("(404)") OrElse If ex.Message.Contains("该下载源不支持") OrElse ex.Message.Contains("未能解析") OrElse ex.Message.Contains("(404)") OrElse
ex.Message.Contains("(502)") OrElse ex.Message.Contains("无返回数据") OrElse ex.Message.Contains("空间不足") OrElse ex.Message.Contains("获取到的分段大小不一致") OrElse ex.Message.Contains("(502)") OrElse ex.Message.Contains("无返回数据") OrElse ex.Message.Contains("空间不足") OrElse ex.Message.Contains("获取到的分段大小不一致") OrElse
(ex.Message.Contains("(403)") AndAlso Not Info.Source.Url.ContainsF("bmclapi")) OrElse 'BMCLAPI 的部分源在高频率请求下会返回 403，所以不应因此禁用下载源 ((ex.Message.Contains("(403)") OrElse ex.Message.Contains("(429)")) AndAlso Not Info.Source.Url.ContainsF("bmclapi")) OrElse 'BMCLAPI 的部分源在高频率请求下会返回 403、429，所以不应因此禁用下载源
(Info.Source.FailCount >= MathClamp(NetTaskThreadLimit, 5, 30) AndAlso DownloadDone < 1) OrElse (Info.Source.FailCount >= MathClamp(NetTaskThreadLimit, 5, 30) AndAlso DownloadDone < 1) OrElse
Info.Source.FailCount > NetTaskThreadLimit + 2 Then Info.Source.FailCount > NetTaskThreadLimit + 2 Then
Dim IsThisFail As Boolean = False Dim IsThisFail As Boolean = False
@@ -1344,7 +1344,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
'检查文件 '检查文件
@@ -1654,6 +1654,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:
@@ -1882,7 +1885,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(70) '减少 BMCLAPI 请求频率，避免 Too Many Requests
Next Next
'为进行中的文件追加线程 '为进行中的文件追加线程
If Speed >= NetTaskSpeedLimitLow Then Continue While '下载速度足够，无需新增 If Speed >= NetTaskSpeedLimitLow Then Continue While '下载速度足够，无需新增
@@ -1902,7 +1905,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(70) '减少 BMCLAPI 请求频率，避免 Too Many Requests
Next Next
End While End While
Catch ex As Exception Catch ex As Exception
@@ -2000,7 +2003,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
Plain Craft Launcher 2/Modules/Base/MyBitmap.vb
+14 -2
View File
@@ -66,8 +66,20 @@ Public Class MyBitmap
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
If Is32BitSystem Then Throw New Exception("不支持在 32 位系统下加载 WebP 图片。")
Dim FileBytes(InputStream.Length - 1) As Byte
InputStream.Read(FileBytes, 0, FileBytes.Length)
Dim Decoder As New Imazen.WebP.SimpleDecoder()
Pic = Decoder.DecodeFromBytes(FileBytes, FileBytes.Length)
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
Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb
+64 -57
View File
@@ -247,7 +247,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
@@ -417,7 +423,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
@@ -536,7 +542,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
@@ -944,30 +950,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 线程
@@ -975,32 +981,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
'等待线程结束 '等待线程结束
@@ -1470,7 +1476,7 @@ 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) File.Dependencies.Add(DepProject.Id)
@@ -1490,10 +1496,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 列表
Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb
+55 -25
View File
@@ -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))("分析资源文件索引地址",
@@ -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})
@@ -1087,29 +1082,46 @@
''' <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 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 If McimUrl <> Url Then
Select Case Setup.Get("ToolDownloadMod") Select Case Setup.Get("ToolDownloadMod")
'UNDONE: 受 #4811 影响
Case 0 Case 0
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30)) If ModeDebug Then
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60)) Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 20))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Else
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 20))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
End If
Case 1 Case 1
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5)) Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 35)) Urls.Add(New KeyValuePair(Of String, Integer)(Url, 20))
Case Else Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60)) Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60)) Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
Case Else
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
End Select End Select
End If 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 +1131,46 @@
''' <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 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 If McimUrl <> Url Then
Select Case Setup.Get("ToolDownloadMod") Select Case Setup.Get("ToolDownloadMod")
'UNDONE: 受 #4811 影响
Case 0 Case 0
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30)) If ModeDebug Then
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60)) Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 20))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Else
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 20))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
End If
Case 1 Case 1
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5)) Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 35)) Urls.Add(New KeyValuePair(Of String, Integer)(Url, 20))
Case Else Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60)) Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60)) Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
Case Else
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 30))
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 60))
End Select End Select
End If 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
Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb
+141 -243
View File
@@ -4,6 +4,7 @@ Public Module ModLaunch
#Region "开始" #Region "开始"
Public CurrentLaunchOptions As McLaunchOptions = Nothing
Public Class McLaunchOptions Public Class McLaunchOptions
''' <summary> ''' <summary>
''' 强制指定在启动后进入的服务器 IP。 ''' 强制指定在启动后进入的服务器 IP。
@@ -20,32 +21,34 @@ Public Module ModLaunch
''' 默认值：Nothing。使用 McVersionCurrent。 ''' 默认值：Nothing。使用 McVersionCurrent。
''' </summary> ''' </summary>
Public Version As McVersion = Nothing Public Version As McVersion = Nothing
''' <summary>
''' 额外的启动参数。
''' </summary>
Public ExtraArgs As New List(Of String)
End Class End Class
''' <summary> ''' <summary>
''' 尝试启动 Minecraft。必须在 UI 线程调用。 ''' 尝试启动 Minecraft。必须在 UI 线程调用。
''' 返回是否实际开始了启动（如果没有，则一定弹出了错误提示）。 ''' 返回是否实际开始了启动（如果没有，则一定弹出了错误提示）。
''' </summary> ''' </summary>
Public Function McLaunchStart(Optional Options As McLaunchOptions = Nothing) As Boolean Public Function McLaunchStart(Optional Options As McLaunchOptions = Nothing) As Boolean
Options = If(Options, New McLaunchOptions) CurrentLaunchOptions = If(Options, New McLaunchOptions)
'预检查 '预检查
If Not RunInUi() Then If Not RunInUi() Then Throw New Exception("McLaunchStart 必须在 UI 线程调用！")
Throw New Exception("McLaunchStart 必须在 UI 线程调用！")
End If
If McLaunchLoader.State = LoadState.Loading Then If McLaunchLoader.State = LoadState.Loading Then
Hint("已有游戏正在启动中！", HintType.Critical) Hint("已有游戏正在启动中！", HintType.Critical)
Return False Return False
End If End If
'强制切换需要启动的版本 '强制切换需要启动的版本
If Options.Version IsNot Nothing AndAlso McVersionCurrent <> Options.Version Then If CurrentLaunchOptions.Version IsNot Nothing AndAlso McVersionCurrent <> CurrentLaunchOptions.Version Then
McLaunchLog("在启动前切换到版本 " & Options.Version.Name) McLaunchLog("在启动前切换到版本 " & CurrentLaunchOptions.Version.Name)
'检查版本 '检查版本
Options.Version.Load() CurrentLaunchOptions.Version.Load()
If Options.Version.State = McVersionState.Error Then If CurrentLaunchOptions.Version.State = McVersionState.Error Then
Hint("无法启动 Minecraft：" & Options.Version.Info, HintType.Critical) Hint("无法启动 Minecraft：" & CurrentLaunchOptions.Version.Info, HintType.Critical)
Return False Return False
End If End If
'切换版本 '切换版本
McVersionCurrent = Options.Version McVersionCurrent = CurrentLaunchOptions.Version
Setup.Set("LaunchVersionSelect", McVersionCurrent.Name) Setup.Set("LaunchVersionSelect", McVersionCurrent.Name)
FrmLaunchLeft.RefreshButtonsUI() FrmLaunchLeft.RefreshButtonsUI()
FrmLaunchLeft.RefreshPage(False, False) FrmLaunchLeft.RefreshPage(False, False)
@@ -95,7 +98,7 @@ Public Module ModLaunch
McLaunchPrecheck() McLaunchPrecheck()
McLaunchLog("预检测已通过") McLaunchLog("预检测已通过")
Catch ex As Exception Catch ex As Exception
Hint(ex.Message, HintType.Critical) If Not ex.Message.StartsWithF("$$") Then Hint(ex.Message, HintType.Critical)
Throw Throw
End Try End Try
'正式加载 '正式加载
@@ -104,7 +107,7 @@ Public Module ModLaunch
Dim Loaders As New List(Of LoaderBase) From { Dim Loaders As New List(Of LoaderBase) From {
New LoaderTask(Of Integer, Integer)("获取 Java", AddressOf McLaunchJava) With {.ProgressWeight = 4, .Block = False}, New LoaderTask(Of Integer, Integer)("获取 Java", AddressOf McLaunchJava) With {.ProgressWeight = 4, .Block = False},
McLoginLoader, McLoginLoader,
New LoaderCombo(Of String)("补全文件", DlClientFix(McVersionCurrent, False, AssetsIndexExistsBehaviour.DownloadInBackground, True)) With {.ProgressWeight = 15, .Show = False}, New LoaderCombo(Of String)("补全文件", DlClientFix(McVersionCurrent, False, AssetsIndexExistsBehaviour.DownloadInBackground)) With {.ProgressWeight = 15, .Show = False},
New LoaderTask(Of String, List(Of McLibToken))("获取启动参数", AddressOf McLaunchArgumentMain) With {.ProgressWeight = 2}, New LoaderTask(Of String, List(Of McLibToken))("获取启动参数", AddressOf McLaunchArgumentMain) With {.ProgressWeight = 2},
New LoaderTask(Of List(Of McLibToken), Integer)("解压文件", AddressOf McLaunchNatives) With {.ProgressWeight = 2}, New LoaderTask(Of List(Of McLibToken), Integer)("解压文件", AddressOf McLaunchNatives) With {.ProgressWeight = 2},
New LoaderTask(Of Integer, Integer)("预启动处理", AddressOf McLaunchPrerun) With {.ProgressWeight = 1}, New LoaderTask(Of Integer, Integer)("预启动处理", AddressOf McLaunchPrerun) With {.ProgressWeight = 1},
@@ -144,7 +147,7 @@ Public Module ModLaunch
Hint(McVersionCurrent.Name & " 启动成功！", HintType.Finish) Hint(McVersionCurrent.Name & " 启动成功！", HintType.Finish)
Case LoadState.Aborted Case LoadState.Aborted
If AbortHint Is Nothing Then If AbortHint Is Nothing Then
Hint(If(Loader.Input.SaveBatch Is Nothing, "已取消启动！", "已取消导出启动脚本！"), HintType.Info) Hint(If(CurrentLaunchOptions?.SaveBatch Is Nothing, "已取消启动！", "已取消导出启动脚本！"), HintType.Info)
Else Else
Hint(AbortHint, HintType.Finish) Hint(AbortHint, HintType.Finish)
End If End If
@@ -159,7 +162,7 @@ NextInner:
If CurrentEx.Message.StartsWithF("$") Then If CurrentEx.Message.StartsWithF("$") Then
'若有以 $ 开头的错误信息，则以此为准显示提示 '若有以 $ 开头的错误信息，则以此为准显示提示
'若错误信息为 $$，则不提示 '若错误信息为 $$，则不提示
If Not CurrentEx.Message = "$$" Then MyMsgBox(CurrentEx.Message.TrimStart("$"), If(Loader.Input.SaveBatch Is Nothing, "启动失败", "导出启动脚本失败")) If Not CurrentEx.Message = "$$" Then MyMsgBox(CurrentEx.Message.TrimStart("$"), If(CurrentLaunchOptions?.SaveBatch Is Nothing, "启动失败", "导出启动脚本失败"))
Throw Throw
ElseIf CurrentEx.InnerException IsNot Nothing Then ElseIf CurrentEx.InnerException IsNot Nothing Then
'检查下一级错误 '检查下一级错误
@@ -168,7 +171,9 @@ NextInner:
Else Else
'没有特殊处理过的错误信息 '没有特殊处理过的错误信息
McLaunchLog("错误：" & GetExceptionDetail(ex)) McLaunchLog("错误：" & GetExceptionDetail(ex))
Log(ex, If(Loader.Input.SaveBatch Is Nothing, "Minecraft 启动失败", "导出启动脚本失败"), LogLevel.Msgbox, If(Loader.Input.SaveBatch Is Nothing, "启动失败", "导出启动脚本失败")) Log(ex,
If(CurrentLaunchOptions?.SaveBatch Is Nothing, "Minecraft 启动失败", "导出启动脚本失败"), LogLevel.Msgbox,
If(CurrentLaunchOptions?.SaveBatch Is Nothing, "启动失败", "导出启动脚本失败"))
Throw Throw
End If End If
End Try End Try
@@ -211,36 +216,45 @@ NextInner:
If McVersionCurrent.State = McVersionState.Error Then Throw New Exception("Minecraft 存在问题：" & McVersionCurrent.Info) If McVersionCurrent.State = McVersionState.Error Then Throw New Exception("Minecraft 存在问题：" & McVersionCurrent.Info)
'检查输入信息 '检查输入信息
Dim CheckResult As String = "" Dim CheckResult As String = ""
RunInUiWait(Sub() RunInUiWait(Sub() CheckResult = McLoginAble(McLoginInput()))
Dim LoginInput As McLoginData = McLoginInput()
CheckResult = McLoginAble(LoginInput)
End Sub)
If CheckResult <> "" Then Throw New ArgumentException(CheckResult) If CheckResult <> "" Then Throw New ArgumentException(CheckResult)
#If BETA Then #If BETA Then
'求赞助 '求赞助
RunInNewThread(Sub() RunInNewThread(
Select Case Setup.Get("SystemLaunchCount") Sub()
Case 20, 50, 100, 150, 200, 250, 300, 350, 400, 450, 500, 600, 700, 800, 900, 1000, 1100, 1200, 1300, 1400, 1500, 1700, 1900, 2100, 2300, 2500 Select Case Setup.Get("SystemLaunchCount")
If MyMsgBox("PCL 已经为你启动了 " & Setup.Get("SystemLaunchCount") & " 次游戏啦！" & vbCrLf & Case 10, 20, 40, 60, 80, 100, 120, 150, 200, 250, 300, 350, 400, 500, 600, 700, 800, 900, 1000, 1200, 1400, 1600, 1800, 2000
"如果觉得 PCL 还算好用的话，也可以考虑赞助一下作者……一点心意也行……" & vbCrLf & If MyMsgBox("PCL 已经为你启动了 " & Setup.Get("SystemLaunchCount") & " 次游戏啦！" & vbCrLf &
"毕竟一个人开发也不容易（悲）……", "如果觉得 PCL 还算好用的话，也可以考虑赞助一下作者……一点心意也行……" & vbCrLf &
"求赞助啦……", "这就赞助！", "但是我拒绝") = 1 Then "毕竟一个人开发也不容易（悲）……",
OpenWebsite("https://afdian.com/a/LTCat") "求赞助啦……", "这就赞助！", "但是我拒绝") = 1 Then
End If OpenWebsite("https://afdian.com/a/LTCat")
End Select End If
End Sub, "Donate") End Select
End Sub, "Donate")
#End If #End If
'正版购买提示 '正版购买提示
If Not Setup.Get("HintBuy") AndAlso Setup.Get("LoginType") <> McLoginType.Ms Then If Not Setup.Get("HintBuy") AndAlso Setup.Get("LoginType") <> McLoginType.Ms Then
Select Case Setup.Get("SystemLaunchCount") If IsSystemLanguageChinese() Then
Case 10, 35, 75, 125, 175, 225, 275, 325, 375, 425, 475, 550, 650, 750, 850, 950, 1050, 1150, 1250, 1350, 1450, 1600, 1800, 2000, 2200, 2400 Select Case Setup.Get("SystemLaunchCount")
If MyMsgBox("你已经启动了 " & Setup.Get("SystemLaunchCount") & " 次 Minecraft 啦！" & vbCrLf & Case 2, 5, 10, 15, 20, 40, 60, 80, 100, 125, 150, 175, 200, 250, 300, 350, 400, 500, 600, 700, 800, 900, 1000, 1200, 1400, 1600, 1800, 2000
"如果觉得 Minecraft 还不错，也可以考虑购买正版支持一下，毕竟开发游戏也很不容易……" & vbCrLf & If MyMsgBox("你已经启动了 " & Setup.Get("SystemLaunchCount") & " 次 Minecraft 啦！" & vbCrLf &
"在你登录一次正版账号后，就不会再出现这个提示了。", "如果觉得 Minecraft 还不错，可以购买正版支持一下，毕竟开发游戏也真的很不容易……" & vbCrLf & vbCrLf &
"考虑一下正版？", "购买正版游戏", "下次一定") = 1 Then "在你登录一次正版账号后，就不会再出现这个提示了！",
OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj") "考虑一下正版？", "支持正版游戏！", "下次一定") = 1 Then
End If OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj")
End Select End If
End Select
ElseIf Setup.Get("LoginType") = McLoginType.Legacy Then
Select Case MyMsgBox("你必须先登录正版账号，才能进行离线登录！", "正版验证", "购买正版", "试玩", "返回",
Button1Action:=Sub() OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj"))
Case 2
Hint("游戏将以试玩模式启动！", HintType.Critical)
CurrentLaunchOptions.ExtraArgs.Add("--demo")
Case 3
Throw New Exception("$$")
End Select
End If
End If End If
End Sub End Sub
@@ -487,58 +501,56 @@ NextInner:
#Region "分方式登录模块" #Region "分方式登录模块"
'各个登录方式的主对象与输入构造 '各个登录方式的主对象与输入构造
Public McLoginMsLoader As New LoaderTask(Of McLoginMs, McLoginResult)("Loader Login Ms", AddressOf McLoginMsStart) With {.ReloadTimeout = 300000} Public McLoginMsLoader As New LoaderTask(Of McLoginMs, McLoginResult)("Loader Login Ms", AddressOf McLoginMsStart)
Public McLoginLegacyLoader As New LoaderTask(Of McLoginLegacy, McLoginResult)("Loader Login Legacy", AddressOf McLoginLegacyStart) Public McLoginLegacyLoader As New LoaderTask(Of McLoginLegacy, McLoginResult)("Loader Login Legacy", AddressOf McLoginLegacyStart)
Public McLoginNideLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Nide", AddressOf McLoginServerStart) With {.ReloadTimeout = 60000} Public McLoginNideLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Nide", AddressOf McLoginServerStart) With {.ReloadTimeout = 1000 * 60 * 10}
Public McLoginAuthLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Auth", AddressOf McLoginServerStart) With {.ReloadTimeout = 60000} Public McLoginAuthLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Auth", AddressOf McLoginServerStart) With {.ReloadTimeout = 1000 * 60 * 10}
'主加载函数，返回所有需要的登录信息 '主加载函数，返回所有需要的登录信息
Private McLoginMsRefreshTime As Long = 0 '上次刷新登录的时间
Private Sub McLoginMsStart(Data As LoaderTask(Of McLoginMs, McLoginResult)) Private Sub McLoginMsStart(Data As LoaderTask(Of McLoginMs, McLoginResult))
Dim Input As McLoginMs = Data.Input Dim Input As McLoginMs = Data.Input
Dim LogUsername As String = Input.UserName Dim LogUsername As String = Input.UserName
McLaunchLog("登录方式：正版（" & If(LogUsername = "", "尚未登录", LogUsername) & "）") McLaunchLog("登录方式：正版（" & If(LogUsername = "", "尚未登录", LogUsername) & "）")
Data.Progress = 0.05 Data.Progress = 0.05
'检查是否已经登录完成 '检查是否已经登录完成
If Input.AccessToken <> "" AndAlso Not Data.IsForceRestarting Then If Not Data.IsForceRestarting AndAlso '不要求强行重启
Input.AccessToken <> "" AndAlso '已经登录过了
(McLoginMsRefreshTime > 0 AndAlso GetTimeTick() - McLoginMsRefreshTime < 1000 * 60 * 10) Then '完成时间在 10 分钟内
Data.Output = New McLoginResult With Data.Output = New McLoginResult With
{.AccessToken = Input.AccessToken, .Name = Input.UserName, .Uuid = Input.Uuid, .Type = "Microsoft", .ClientToken = Input.Uuid, .ProfileJson = Input.ProfileJson} {.AccessToken = Input.AccessToken, .Name = Input.UserName, .Uuid = Input.Uuid, .Type = "Microsoft", .ClientToken = Input.Uuid, .ProfileJson = Input.ProfileJson}
GoTo SkipLogin GoTo SkipLogin
End If End If
'尝试登录 '尝试登录
Dim OAuthTokens As String() Dim OAuthTokens As String()
Dim ClientId As String = ""
If Input.OAuthRefreshToken = "" Then If Input.OAuthRefreshToken = "" Then
'无 RefreshToken '无 RefreshToken
Relogin: Relogin:
Dim OAuthCode As String = MsLoginStep1(Data) OAuthTokens = MsLoginStep1New(Data)
If OAuthCode = "Cancel" Then Exit Sub
If Data.IsAborted Then Throw New ThreadInterruptedException
Data.Progress = 0.2
OAuthTokens = MsLoginStep2(OAuthCode, False, ClientId)
Else Else
'有 RefreshToken '有 RefreshToken
OAuthTokens = MsLoginStep2(Input.OAuthRefreshToken, True, ClientId) OAuthTokens = MsLoginStep1Refresh(Input.OAuthRefreshToken) '要求重新打开登录网页认证
If OAuthTokens(0) = "Relogin" Then GoTo Relogin
End If End If
'要求重新打开登录网页认证 If Data.IsAborted Then Throw New ThreadInterruptedException
If OAuthTokens(0) = "Cancel" Then Exit Sub Data.Progress = 0.25
If OAuthTokens(0) = "Relogin" Then GoTo Relogin
Data.Progress = 0.35
If Data.IsAborted Then Throw New ThreadInterruptedException If Data.IsAborted Then Throw New ThreadInterruptedException
Dim OAuthAccessToken As String = OAuthTokens(0) Dim OAuthAccessToken As String = OAuthTokens(0)
Dim OAuthRefreshToken As String = OAuthTokens(1) Dim OAuthRefreshToken As String = OAuthTokens(1)
Dim XBLToken As String = MsLoginStep3(OAuthAccessToken) Dim XBLToken As String = MsLoginStep2(OAuthAccessToken)
Data.Progress = 0.5 Data.Progress = 0.4
If Data.IsAborted Then Throw New ThreadInterruptedException If Data.IsAborted Then Throw New ThreadInterruptedException
Dim Tokens = MsLoginStep4(XBLToken) Dim Tokens = MsLoginStep3(XBLToken)
Data.Progress = 0.65 Data.Progress = 0.55
If Data.IsAborted Then Throw New ThreadInterruptedException If Data.IsAborted Then Throw New ThreadInterruptedException
Dim AccessToken As String = MsLoginStep5(Tokens) Dim AccessToken As String = MsLoginStep4(Tokens)
Data.Progress = 0.8 Data.Progress = 0.7
If Data.IsAborted Then Throw New ThreadInterruptedException If Data.IsAborted Then Throw New ThreadInterruptedException
MsLoginStep6(AccessToken) MsLoginStep5(AccessToken)
Data.Progress = 0.9 Data.Progress = 0.85
If Data.IsAborted Then Throw New ThreadInterruptedException If Data.IsAborted Then Throw New ThreadInterruptedException
Dim Result = MsLoginStep7(AccessToken) Dim Result = MsLoginStep6(AccessToken)
Data.Progress = 0.98
'输出登录结果 '输出登录结果
Setup.Set("CacheMsOAuthRefresh", OAuthRefreshToken) Setup.Set("CacheMsOAuthRefresh", OAuthRefreshToken)
Setup.Set("CacheMsAccess", AccessToken) Setup.Set("CacheMsAccess", AccessToken)
@@ -550,11 +562,11 @@ Relogin:
MsJson(Result(1)) = OAuthRefreshToken MsJson(Result(1)) = OAuthRefreshToken
Setup.Set("LoginMsJson", MsJson.ToString(Newtonsoft.Json.Formatting.None)) Setup.Set("LoginMsJson", MsJson.ToString(Newtonsoft.Json.Formatting.None))
Data.Output = New McLoginResult With {.AccessToken = AccessToken, .Name = Result(1), .Uuid = Result(0), .Type = "Microsoft", .ClientToken = Result(0), .ProfileJson = Result(2)} Data.Output = New McLoginResult With {.AccessToken = AccessToken, .Name = Result(1), .Uuid = Result(0), .Type = "Microsoft", .ClientToken = Result(0), .ProfileJson = Result(2)}
'解锁主题 '结束
SkipLogin: McLoginMsRefreshTime = GetTimeTick()
McLaunchLog("微软登录完成") McLaunchLog("微软登录完成")
SkipLogin:
Setup.Set("HintBuy", True) '关闭正版购买提示 Setup.Set("HintBuy", True) '关闭正版购买提示
Data.Progress = 0.98
If ThemeUnlock(10, False) Then MyMsgBox("感谢你对正版游戏的支持！" & vbCrLf & "隐藏主题 跳票红 已解锁！", "提示") If ThemeUnlock(10, False) Then MyMsgBox("感谢你对正版游戏的支持！" & vbCrLf & "隐藏主题 跳票红 已解锁！", "提示")
End Sub End Sub
Private Sub McLoginServerStart(Data As LoaderTask(Of McLoginServer, McLoginResult)) Private Sub McLoginServerStart(Data As LoaderTask(Of McLoginServer, McLoginResult))
@@ -821,179 +833,61 @@ LoginFinish:
End Try End Try
End Function End Function
'微软登录步骤 1：打开网页认证，获取 OAuth Code '微软登录步骤 1，原始登录：获取 DeviceCode 并开启登录网页
Private Function MsLoginStep1(Data As LoaderTask(Of McLoginMs, McLoginResult)) As String Private Function MsLoginStep1New(Data As LoaderTask(Of McLoginMs, McLoginResult)) As String()
McLaunchLog("开始微软登录步骤 1") '参考：https://learn.microsoft.com/zh-cn/entra/identity-platform/v2-oauth2-device-code
OpenWebsite(FormLoginOAuth.LoginUrl1)
Dim Result As String =
MyMsgBoxInput("等待网页登录",
"登录完成后，网页会变得完全空白。把那个空白网页的网址复制到下面的框中就行！" & vbCrLf &
"如果网络环境不佳，它可能一直加载不出来，那就只能试试用 VPN 或加速器了。",
ValidateRules:=New ObjectModel.Collection(Of Validate) From {New ValidateRegex("(?<=code\=)[^&]+", "返回网址应以 https://login.live.com/oauth20_desktop.srf?code= 开头")},
HintText:="https://login.live.com/oauth20_desktop.srf?code=XXXXXX")
If Result Is Nothing Then
McLaunchLog("微软登录已在步骤 1 被取消")
Throw New ThreadInterruptedException("$$")
Else
Return RegexSeek(Result, "(?<=code\=)[^&]+")
End If
End Function
'微软登录步骤 2：从 OAuth Code 或 OAuth RefreshToken 获取 {OAuth AccessToken, OAuth RefreshToken} '初始请求
Private Function MsLoginStep2(Code As String, IsRefresh As Boolean, ClientId As String, Optional ExpiresIn As String = "900") As String() McLaunchLog("开始微软登录步骤 1/6（原始登录）")
McLaunchLog("开始微软登录步骤 2（" & If(IsRefresh, "", "非") & "刷新登录）") Dim PrepareJson As JObject = GetJson(NetRequestMulty("https://login.microsoftonline.com/consumers/oauth2/v2.0/devicecode", "POST",
$"client_id={OAuthClientId}&tenant=/consumers&scope=XboxLive.signin%20offline_access", "application/x-www-form-urlencoded", 2))
McLaunchLog("网页登录地址：" & PrepareJson("verification_uri").ToString)
Dim Request As String '弹窗
If IsRefresh Then Dim Converter As New MyMsgBoxConverter With {.Content = PrepareJson, .ForceWait = True, .Type = MyMsgBoxType.Login}
Request = "grant_type=refresh_token" & "&" & WaitingMyMsgBox.Add(Converter)
"client_id=" & ClientId & "&" & While Converter.Result Is Nothing
"device_code=" & Code & "&" & Thread.Sleep(100)
"refresh_token=" & Uri.EscapeDataString(Code) & "&" &
"scope=XboxLive.signin%20offline_access"
Else
Request = "grant_type=urn:ietf:params:oauth:grant-type:device_code" & "&" &
"client_id=" & ClientId & "&" &
"device_code=" & Code & "&" &
"scope=XboxLive.signin%20offline_access"
End If
Dim Result As String
Dim stopwatch As Stopwatch = Stopwatch.StartNew()
While stopwatch.Elapsed < TimeSpan.FromSeconds(ExpiresIn)
Try
Result = NetRequestMulty("https://login.microsoftonline.com/consumers/oauth2/v2.0/token", "POST", Request, "application/x-www-form-urlencoded", 2)
Catch ex As Exception
If ex.Message.Contains("must sign in again") OrElse ex.Message.Contains("invalid_grant") Then '#269
Return {"Relogin", ""}
ElseIf ex.Message.Contains("authorization_declined") Then
Hint("你拒绝了 PCL2 的访问权限申请，验证过程被中断！")
Return {"Cancel", ""}
ElseIf ex.Message.Contains("expired_token") Then
Hint("Token 已过期，请尝试重新验证！")
Exit While
ElseIf ex.Message.Contains("AADSTS70016") Then
Continue While
Else
Throw
End If
End Try
If Result IsNot Nothing Then
Dim ResultJson As JObject = GetJson(Result)
Dim AccessToken As String = ResultJson("access_token").ToString
Dim RefreshToken As String = ResultJson("refresh_token").ToString
Return {AccessToken, RefreshToken}
End If
Thread.Sleep(1000)
End While End While
If TypeOf Converter.Result Is Exception Then
Hint("验证超时，请尝试重新验证！") Throw CType(Converter.Result, Exception)
Return {"Cancel", ""} Else
Return Converter.Result
End If
End Function End Function
''微软登录步骤 1：获取 DeviceCode 并显示验证提示 '微软登录步骤 1，刷新登录：从 OAuth Code 或 OAuth RefreshToken 获取 {OAuth AccessToken, OAuth RefreshToken}
''https://learn.microsoft.com/zh-cn/entra/identity-platform/v2-oauth2-device-code Private Function MsLoginStep1Refresh(Code As String) As String()
'Private Function MsLoginStep1(Data As LoaderTask(Of McLoginMs, McLoginResult)) As String McLaunchLog("开始微软登录步骤 1/6（刷新登录）")
' McLaunchLog("开始微软登录步骤 1：获取验证信息")
' Dim PrepareJson As JObject = GetJson(NetRequestMulty("https://login.microsoftonline.com/consumers/oauth2/v2.0/devicecode", "POST",
' $"client_id={OAuthClientId}&scope=XboxLive.signin%20offline_access", "application/x-www-form-urlencoded", 2))
' '从这里开始直到步骤 2 结束都没有 Review Dim Result As String
' '参考：https://learn.microsoft.com/zh-cn/entra/identity-platform/v2-oauth2-device-code Try
' If MyMsgBox("请在打开的网页里输入 PCL2 提供的设备代码（会自动复制到剪贴板）。" & vbCrLf & Result = NetRequestMulty("https://login.live.com/oauth20_token.srf", "POST",
' "设备代码有时效性，若操作时间过长需要重新进行登录流程。", "正版验证确认", "继续", "取消") <> 1 Then $"client_id={OAuthClientId}&refresh_token={Uri.EscapeDataString(Code)}&grant_type=refresh_token&scope=XboxLive.signin%20offline_access",
' Return "Cancel" "application/x-www-form-urlencoded", 2)
' End If Catch ex As Exception
If ex.Message.Contains("must sign in again") OrElse ex.Message.Contains("invalid_grant") Then '#269
Return {"Relogin", ""}
Else
Throw
End If
End Try
' Dim DeviceCode As String = PrepareJson("device_code") Dim ResultJson As JObject = GetJson(Result)
' Dim UserCode As String = PrepareJson("user_code") Dim AccessToken As String = ResultJson("access_token").ToString
' Dim VerifyUri As String = PrepareJson("verification_uri") Dim RefreshToken As String = ResultJson("refresh_token").ToString
' 'ResultJson("expires_in") Return {AccessToken, RefreshToken}
' ClipboardSet(UserCode) End Function
' OpenWebsite(VerifyUri)
' Dim MsgBoxValue As String = "" '微软登录步骤 2：从 OAuth AccessToken 获取 XBLToken
' While MsgBoxValue IsNot "1" Private Function MsLoginStep2(AccessToken As String) As String
' MsgBoxValue = MyMsgBox("本次验证的设备代码为：" & UserCode & vbCrLf & vbCrLf & "你也可以在任意设备上打开下列网址进行验证：" & vbCrLf & VerifyUri & vbCrLf & vbCrLf & "在验证完成后，你可以直接关闭这个弹窗，PCL2 会自动完成接下来的流程。", "正版验证", "关闭", "复制网址", "复制设备代码").ToString McLaunchLog("开始微软登录步骤 2/6")
' If MsgBoxValue = "2" Then
' ClipboardSet(VerifyUri)
' Continue While
' ElseIf MsgBoxValue = "3" Then
' ClipboardSet(UserCode)
' Continue While
' ElseIf MsgBoxValue = "1" Then
' Exit While
' End If
' End While
' Return DeviceCode
'End Function
''微软登录步骤 2：从 OAuth Code 或 OAuth RefreshToken 获取 {OAuth AccessToken, OAuth RefreshToken}
'Private Function MsLoginStep2(Code As String, IsRefresh As Boolean, Optional ExpiresIn As String = "900") As String()
' McLaunchLog("开始微软登录步骤 2（" & If(IsRefresh, "", "非") & "刷新登录）")
' Dim Request As String
' If IsRefresh Then
' Request = "grant_type=refresh_token" & "&" &
' "client_id=" & OAuthClientId & "&" &
' "device_code=" & Code & "&" &
' "refresh_token=" & Uri.EscapeDataString(Code) & "&" &
' "scope=XboxLive.signin%20offline_access"
' Else
' Request = "grant_type=urn:ietf:params:oauth:grant-type:device_code" & "&" &
' "client_id=" & OAuthClientId & "&" &
' "device_code=" & Code & "&" &
' "scope=XboxLive.signin%20offline_access"
' End If
' Dim Result As String
' Dim stopwatch As Stopwatch = Stopwatch.StartNew()
' While stopwatch.Elapsed < TimeSpan.FromSeconds(ExpiresIn)
' Try
' Result = NetRequestMulty("https://login.microsoftonline.com/consumers/oauth2/v2.0/token", "POST", Request, "application/x-www-form-urlencoded", 2)
' Catch ex As Exception
' If ex.Message.Contains("must sign in again") OrElse ex.Message.Contains("invalid_grant") Then '#269
' Return {"Relogin", ""}
' ElseIf ex.Message.Contains("authorization_declined") Then
' Hint("你拒绝了 PCL2 的访问权限申请，验证过程被中断！")
' Return {"Cancel", ""}
' ElseIf ex.Message.Contains("expired_token") Then
' Hint("Token 已过期，请尝试重新验证！")
' Exit While
' ElseIf ex.Message.Contains("AADSTS70016") Then
' Continue While
' Else
' Throw
' End If
' End Try
' If Result IsNot Nothing Then
' Dim ResultJson As JObject = GetJson(Result)
' Dim AccessToken As String = ResultJson("access_token").ToString
' Dim RefreshToken As String = ResultJson("refresh_token").ToString
' Return {AccessToken, RefreshToken}
' End If
' Thread.Sleep(1000)
' End While
' Hint("验证超时，请尝试重新验证！")
' Return {"Cancel", ""}
'End Function
'微软登录步骤 3：从 OAuth AccessToken 获取 XBLToken
Private Function MsLoginStep3(AccessToken As String) As String
McLaunchLog("开始微软登录步骤 3")
Dim Request As String = "{ Dim Request As String = "{
""Properties"": { ""Properties"": {
""AuthMethod"": ""RPS"", ""AuthMethod"": ""RPS"",
""SiteName"": ""user.auth.xboxlive.com"", ""SiteName"": ""user.auth.xboxlive.com"",
""RpsTicket"": """ & AccessToken & """ ""RpsTicket"": """ & If(AccessToken.StartsWithF("d="), "", "d=") & AccessToken & """
}, },
""RelyingParty"": ""http://auth.xboxlive.com"", ""RelyingParty"": ""http://auth.xboxlive.com"",
""TokenType"": ""JWT"" ""TokenType"": ""JWT""
@@ -1004,9 +898,9 @@ LoginFinish:
Dim XBLToken As String = ResultJson("Token").ToString Dim XBLToken As String = ResultJson("Token").ToString
Return XBLToken Return XBLToken
End Function End Function
'微软登录步骤 4：从 XBLToken 获取 {XSTSToken, UHS} '微软登录步骤 3：从 XBLToken 获取 {XSTSToken, UHS}
Private Function MsLoginStep4(XBLToken As String) As String() Private Function MsLoginStep3(XBLToken As String) As String()
McLaunchLog("开始微软登录步骤 4") McLaunchLog("开始微软登录步骤 3/6")
Dim Request As String = "{ Dim Request As String = "{
""Properties"": { ""Properties"": {
@@ -1056,9 +950,9 @@ LoginFinish:
Dim UHS As String = ResultJson("DisplayClaims")("xui")(0)("uhs").ToString Dim UHS As String = ResultJson("DisplayClaims")("xui")(0)("uhs").ToString
Return {XSTSToken, UHS} Return {XSTSToken, UHS}
End Function End Function
'微软登录步骤 5：从 {XSTSToken, UHS} 获取 Minecraft AccessToken '微软登录步骤 4：从 {XSTSToken, UHS} 获取 Minecraft AccessToken
Private Function MsLoginStep5(Tokens As String()) As String Private Function MsLoginStep4(Tokens As String()) As String
McLaunchLog("开始微软登录步骤 5") McLaunchLog("开始微软登录步骤 4/6")
Dim Request As String = New JObject(New JProperty("identityToken", $"XBL3.0 x={Tokens(1)};{Tokens(0)}")).ToString(0) Dim Request As String = New JObject(New JProperty("identityToken", $"XBL3.0 x={Tokens(1)};{Tokens(0)}")).ToString(0)
Dim Result As String Dim Result As String
@@ -1081,9 +975,9 @@ LoginFinish:
Dim AccessToken As String = ResultJson("access_token").ToString Dim AccessToken As String = ResultJson("access_token").ToString
Return AccessToken Return AccessToken
End Function End Function
'微软登录步骤 6：验证微软账号是否持有 MC，这也会刷新 XGP '微软登录步骤 5：验证微软账号是否持有 MC，这也会刷新 XGP
Private Sub MsLoginStep6(AccessToken As String) Private Sub MsLoginStep5(AccessToken As String)
McLaunchLog("开始微软登录步骤 6") McLaunchLog("开始微软登录步骤 5/6")
Dim Result As String = NetRequestMulty("https://api.minecraftservices.com/entitlements/mcstore", "GET", "", "application/json", 2, New Dictionary(Of String, String) From {{"Authorization", "Bearer " & AccessToken}}) Dim Result As String = NetRequestMulty("https://api.minecraftservices.com/entitlements/mcstore", "GET", "", "application/json", 2, New Dictionary(Of String, String) From {{"Authorization", "Bearer " & AccessToken}})
Try Try
@@ -1100,9 +994,9 @@ LoginFinish:
Throw Throw
End Try End Try
End Sub End Sub
'微软登录步骤 7：从 Minecraft AccessToken 获取 {UUID, UserName, ProfileJson} '微软登录步骤 6：从 Minecraft AccessToken 获取 {UUID, UserName, ProfileJson}
Private Function MsLoginStep7(AccessToken As String) As String() Private Function MsLoginStep6(AccessToken As String) As String()
McLaunchLog("开始微软登录步骤 7") McLaunchLog("开始微软登录步骤 6/6")
Dim Result As String Dim Result As String
Try Try
@@ -1447,8 +1341,12 @@ LoginFinish:
Arguments = Arguments.Replace(" -Dos.name=Windows 10", " -Dos.name=""Windows 10""") Arguments = Arguments.Replace(" -Dos.name=Windows 10", " -Dos.name=""Windows 10""")
'全屏 '全屏
If Setup.Get("LaunchArgumentWindowType") = 0 Then Arguments += " --fullscreen" If Setup.Get("LaunchArgumentWindowType") = 0 Then Arguments += " --fullscreen"
'由 Option 传入的额外参数
For Each Arg In CurrentLaunchOptions.ExtraArgs
Arguments += " " & Arg.Trim
Next
'进服 '进服
Dim Server As String = If(String.IsNullOrEmpty(McLaunchLoader.Input.ServerIp), Setup.Get("VersionServerEnter", McVersionCurrent), McLaunchLoader.Input.ServerIp) Dim Server As String = If(String.IsNullOrEmpty(CurrentLaunchOptions.ServerIp), Setup.Get("VersionServerEnter", McVersionCurrent), CurrentLaunchOptions.ServerIp)
If Server.Length > 0 Then If Server.Length > 0 Then
If McVersionCurrent.ReleaseTime > New Date(2023, 4, 4) Then If McVersionCurrent.ReleaseTime > New Date(2023, 4, 4) Then
'QuickPlay 'QuickPlay
@@ -2148,18 +2046,18 @@ IgnoreCustomSkin:
"""" & McLaunchJavaSelected.PathJava & """ " & McLaunchArgument & vbCrLf & """" & McLaunchJavaSelected.PathJava & """ " & McLaunchArgument & vbCrLf &
"echo 游戏已退出。" & vbCrLf & "echo 游戏已退出。" & vbCrLf &
"pause" "pause"
WriteFile(If(McLaunchLoader.Input.SaveBatch, Path & "PCL\LatestLaunch.bat"), SecretFilter(CmdString, "F"), WriteFile(If(CurrentLaunchOptions.SaveBatch, Path & "PCL\LatestLaunch.bat"), SecretFilter(CmdString, "F"),
Encoding:=If(Encoding.Default.Equals(Encoding.UTF8), Encoding.UTF8, Encoding.GetEncoding("GB18030"))) Encoding:=If(Encoding.Default.Equals(Encoding.UTF8), Encoding.UTF8, Encoding.GetEncoding("GB18030")))
If McLaunchLoader.Input.SaveBatch IsNot Nothing Then If CurrentLaunchOptions.SaveBatch IsNot Nothing Then
McLaunchLog("导出启动脚本完成，强制结束启动过程") McLaunchLog("导出启动脚本完成，强制结束启动过程")
AbortHint = "导出启动脚本成功！" AbortHint = "导出启动脚本成功！"
OpenExplorer("/select,""" & McLaunchLoader.Input.SaveBatch & """") OpenExplorer("/select,""" & CurrentLaunchOptions.SaveBatch & """")
Loader.Parent.Abort() Loader.Parent.Abort()
Exit Sub '导出脚本完成 Exit Sub '导出脚本完成
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "输出启动脚本失败") Log(ex, "输出启动脚本失败")
If McLaunchLoader.Input.SaveBatch IsNot Nothing Then Throw ex '直接触发启动失败 If CurrentLaunchOptions.SaveBatch IsNot Nothing Then Throw ex '直接触发启动失败
End Try End Try
'执行自定义命令 '执行自定义命令
Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb
+100 -114
View File
@@ -475,22 +475,27 @@ 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") If Not File.Exists(Path & Name & ".json") Then Throw New Exception($"未找到版本 JSON 文件：{Path}{Name}.json")
_JsonText = ReadFile(Path & Name & ".json") _JsonText = ReadFile(Path & Name & ".json")
'如果 ReadFile 失败会返回空字符串；这可能是由于文件被临时占用，故延时后重试 '如果 ReadFile 失败会返回空字符串；这可能是由于文件被临时占用，故延时后重试
If _JsonText.Length = 0 Then If Not FastJsonCheck(_JsonText) Then
If RunInUi() Then If RunInUi() Then
Log("[Minecraft] 版本 json 文件为空或读取失败，由于代码在主线程运行，将不再进行重试", LogLevel.Debug) Log("[Minecraft] 版本 JSON 文件为空或有误，由于代码在主线程运行，将不再进行重试", LogLevel.Debug)
Throw New Exception("版本 Json 文件为空或读取失败") GetJson(_JsonText) '触发异常
Else Else
Log("[Minecraft] 版本 json 文件为空或读取失败，将在 2s 后重试读取（" & Path & Name & ".json）", LogLevel.Debug) Log("[Minecraft] 版本 JSON 文件为空或有误，将在 2s 后重试读取（" & Path & Name & ".json）", LogLevel.Debug)
Thread.Sleep(2000) Thread.Sleep(2000)
_JsonText = ReadFile(Path & Name & ".json") _JsonText = ReadFile(Path & Name & ".json")
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
@@ -562,11 +567,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
@@ -1030,21 +1034,21 @@ 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 | 毒马铃薯一直都被大家忽视和低估，于是我们超级加强了它！"
Else Else
Return "" Return ""
End If End If
@@ -1946,17 +1950,13 @@ OnLoaded:
End Try End Try
If CoreJarOnly Then Return Result 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] 开始获取统一通行证下载信息")
@@ -1966,14 +1966,13 @@ OnLoaded:
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
@@ -1982,45 +1981,59 @@ OnLoaded:
If Setup.Get("VersionServerLogin", Version:=Version) = 4 OrElse If Setup.Get("VersionServerLogin", Version:=Version) = 4 OrElse
(PageLinkHiper.HiperState = LoadState.Finished AndAlso Setup.Get("LoginType") = McLoginType.Legacy) Then 'HiPer 登录转接 (PageLinkHiper.HiperState = LoadState.Finished AndAlso Setup.Get("LoginType") = McLoginType.Legacy) Then 'HiPer 登录转接
Dim TargetFile = PathAppdata & "authlib-injector.jar" Dim TargetFile = PathAppdata & "authlib-injector.jar"
If Not (IsSetupSkip AndAlso File.Exists(TargetFile)) Then Dim DownloadInfo As JObject = Nothing
Dim DownloadInfo As JObject = Nothing '获取下载信息
'获取下载信息 Try
Try Log("[Minecraft] 开始获取 Authlib-Injector 下载信息")
Log("[Minecraft] 开始获取 Authlib-Injector 下载信息") DownloadInfo = GetJson(NetGetCodeByDownload({
DownloadInfo = GetJson(NetGetCodeByDownload({"https://bmclapi2.bangbang93.com/mirrors/authlib-injector/artifact/latest.json"}, IsJson:=True)) "https://authlib-injector.yushi.moe/artifact/latest.json",
Catch ex As Exception "https://bmclapi2.bangbang93.com/mirrors/authlib-injector/artifact/latest.json"
Log(ex, "获取 Authlib-Injector 下载信息失败") }, IsJson:=True))
End Try Catch ex As Exception
'校验文件 Log(ex, "获取 Authlib-Injector 下载信息失败")
If DownloadInfo IsNot Nothing Then End Try
Dim Checker As New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString) '校验文件
If (IsSetupSkip AndAlso File.Exists(TargetFile)) OrElse Checker.Check(TargetFile) IsNot Nothing Then If DownloadInfo IsNot Nothing Then
'开始下载 Dim Checker As New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString)
Dim DownloadAddress As String = DownloadInfo("download_url") If Checker.Check(TargetFile) IsNot Nothing Then
Log("[Minecraft] Authlib-Injector 需要更新：" & DownloadAddress, LogLevel.Developer) '开始下载
Result.Add(New NetFile({DownloadAddress}, TargetFile, New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString))) Dim DownloadAddress As String = DownloadInfo("download_url").ToString.
End If Replace("bmclapi2.bangbang93.com/mirrors/authlib-injector", "authlib-injector.yushi.moe")
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)
@@ -2159,77 +2172,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 +2224,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
Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb
+17 -19
View File
@@ -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
@@ -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)
@@ -852,7 +853,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 +862,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 +888,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))
@@ -901,8 +903,8 @@ Finished:
'排序 '排序
ModList = Sort(ModList, ModList = Sort(ModList,
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,7 +926,6 @@ 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
@@ -944,7 +945,7 @@ Finished:
'McVersions = McVersions.Distinct().ToList() '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 +980,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 +1005,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 +1023,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 +1046,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,7 +1055,6 @@ 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
@@ -1066,10 +1065,9 @@ Finished:
Dim NewestVersion As String = Nothing Dim NewestVersion As String = Nothing
Dim NewestFileIds As New List(Of Integer) Dim NewestFileIds As New List(Of Integer)
For Each IndexEntry In ProjectJson("latestFilesIndexes") For Each IndexEntry In ProjectJson("latestFilesIndexes")
If 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 +1112,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,7 +1129,7 @@ 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)))
Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb
+36 -36
View File
@@ -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
'强制关闭 '强制关闭
Plain Craft Launcher 2/Modules/Minecraft/MyCompItem.xaml.vb
-6
View File
@@ -55,12 +55,6 @@ RetryStart:
End If End If
'下载图片 '下载图片
NetDownload(Url, LocalFileAddress & DownloadEnd, True) NetDownload(Url, LocalFileAddress & DownloadEnd, True)
If Url.EndsWithF("webp") Then
Log($"[Comp] Webp 格式转换：{LocalFileAddress}")
Dim dec = New Imazen.WebP.SimpleDecoder()
Dim picFile = File.ReadAllBytes(LocalFileAddress & DownloadEnd)
dec.DecodeFromBytes(picFile, picFile.Length).Save(LocalFileAddress & DownloadEnd)
End If
Dim LoadError As Exception = Nothing Dim LoadError As Exception = Nothing
RunInUiWait( RunInUiWait(
Sub() Sub()
Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml
+14 -17
View File
@@ -27,27 +27,24 @@
<Image x:Name="PathLogo" RenderOptions.BitmapScalingMode="HighQuality" /> <Image x:Name="PathLogo" RenderOptions.BitmapScalingMode="HighQuality" />
</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" />
<TextBlock x:Name="LabTitleRaw" TextTrimming="WordEllipsis" FontSize="12" IsHitTestVisible="False"
Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" />
<!-- 更新按钮 -->
<local:MyIconButton Width="21" Height="21" Margin="-2,-1.6,0,0" x:Name="BtnUpdate" Theme="Black" Opacity="0.4" Visibility="Collapsed"
ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="100" ToolTipService.VerticalOffset="-9"
Logo="M640 768H384l-32-32V509H213L190 454l298-298h45l298 298L810 509h-138v226z m-224-64h192V477l32-32h93L512 223 290 445H384l32 32zM352 831h320v64h-320z" />
</StackPanel>
<!--<Grid Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0" IsHitTestVisible="False" SnapsToDevicePixels="False" UseLayoutRounding="False">
<Grid.ColumnDefinitions> <Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" /> <ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" /> <ColumnDefinition Width="Auto" x:Name="ColumnSubtitle" />
<ColumnDefinition Width="Auto" /> <ColumnDefinition Width="Auto" />
<ColumnDefinition Width="1*" x:Name="ColumnExtend" />
</Grid.ColumnDefinitions> </Grid.ColumnDefinitions>
<TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" Grid.Column="0" /> <TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" IsHitTestVisible="False" />
<TextBlock x:Name="LabTitleRaw" TextTrimming="WordEllipsis" FontSize="12" Grid.Column="1" <TextBlock x:Name="LabSubtitle" Grid.Column="1" HorizontalAlignment="Left"
Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" /> TextTrimming="CharacterEllipsis" FontSize="12" IsHitTestVisible="False"
<local:MyIconTextButton Grid.Column="2" Text="更新" /> Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" />
</Grid>--> <!-- 更新按钮 -->
<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"
Logo="M640 768H384l-32-32V509H213L190 454l298-298h45l298 298L810 509h-138v226z m-224-64h192V477l32-32h93L512 223 290 445H384l32 32zM352 831h320v64h-320z" />
</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">
Plain Craft Launcher 2/Modules/Minecraft/MyLocalModItem.xaml.vb
+23 -15
View File
@@ -14,6 +14,7 @@ Public Class MyLocalModItem
Set(value As String) Set(value As String)
If _Logo = value OrElse value Is Nothing Then Exit Property If _Logo = value OrElse value Is Nothing Then Exit Property
_Logo = value _Logo = value
If ModeDebug AndAlso Not _Logo = PathImage & "Icons/NoIcon.png" Then Log($"[LocalModItem] Mod {Title} 的图标：{value}")
Dim FileAddress = PathTemp & "CompLogo\" & GetHash(_Logo) & ".png" Dim FileAddress = PathTemp & "CompLogo\" & GetHash(_Logo) & ".png"
Try Try
If _Logo.StartsWithF("http", True) Then If _Logo.StartsWithF("http", True) Then
@@ -52,17 +53,11 @@ RetryStart:
Try Try
'CurseForge 图片使用缩略图 'CurseForge 图片使用缩略图
Dim Url As String = _Logo Dim Url As String = _Logo
If Url.Contains("/256/256/") AndAlso GetPixelSize(1) <= 1.25 AndAlso Not Retried Then If Url.Contains("/256/256/") AndAlso GetPixelSize(1) <= 1.25 AndAlso Not Retried Then '#3075：部分 Mod 不存在 64x64 图标，所以重试时不再缩小
Url = Url.Replace("/256/256/", "/64/64/") '#3075：部分 Mod 不存在 64x64 图标，所以重试时不再缩小 Url = Url.Replace("/256/256/", "/64/64/")
End If End If
'下载图片 '下载图片
NetDownload(Url, LocalFileAddress & DownloadEnd, True) NetDownload(Url, LocalFileAddress & DownloadEnd, True)
If Url.EndsWithF("webp") Then
Log($"[Comp] Webp 格式转换：{LocalFileAddress}")
Dim dec = New Imazen.WebP.SimpleDecoder()
Dim picFile = File.ReadAllBytes(LocalFileAddress & DownloadEnd)
dec.DecodeFromBytes(picFile, picFile.Length).Save(LocalFileAddress & DownloadEnd)
End If
Dim LoadError As Exception = Nothing Dim LoadError As Exception = Nothing
RunInUiWait( RunInUiWait(
Sub() Sub()
@@ -107,7 +102,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 +115,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
@@ -430,7 +425,7 @@ RetryStart:
NewDescription = GetFileNameWithoutExtentionFromPath(Entry.Path) NewDescription = GetFileNameWithoutExtentionFromPath(Entry.Path)
Case McMod.McModState.Disabled Case McMod.McModState.Disabled
NewDescription = GetFileNameWithoutExtentionFromPath(Entry.Path.Replace(".disabled", "").Replace(".old", "")) NewDescription = GetFileNameWithoutExtentionFromPath(Entry.Path.Replace(".disabled", "").Replace(".old", ""))
Case Else 'McMod.McModState.Unavaliable Case Else 'McMod.McModState.Unavailable
NewDescription = GetFileNameFromPath(Entry.Path) NewDescription = GetFileNameFromPath(Entry.Path)
End Select End Select
If Entry.Comp IsNot Nothing Then If Entry.Comp IsNot Nothing Then
@@ -461,7 +456,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
@@ -538,4 +533,17 @@ RetryStart:
FrmVersionMod.UpdateMods({Entry}) FrmVersionMod.UpdateMods({Entry})
End Sub End Sub
'自适应（#4465）
Private Sub PanTitle_SizeChanged(sender As Object, e As SizeChangedEventArgs) Handles PanTitle.SizeChanged
If ColumnExtend.Width.IsStar AndAlso ColumnExtend.ActualWidth < 0.5 Then
'压缩 Subtitle
ColumnSubtitle.Width = New GridLength(1, GridUnitType.Star)
ColumnExtend.Width = New GridLength(0, GridUnitType.Pixel)
ElseIf Not ColumnExtend.Width.IsStar AndAlso ColumnSubtitle.ActualWidth > LabSubtitle.ActualWidth + 10 Then
'向右展开 Subtitle
ColumnSubtitle.Width = GridLength.Auto
ColumnExtend.Width = New GridLength(1, GridUnitType.Star)
End If
End Sub
End Class End Class
Plain Craft Launcher 2/Modules/ModMain.vb
+17 -12
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
@@ -798,8 +805,6 @@ NextFile:
Public Declare Function SetForegroundWindow Lib "user32" (hWnd As IntPtr) As Integer Public Declare Function SetForegroundWindow Lib "user32" (hWnd As IntPtr) As Integer
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (hWnd As IntPtr, msg As UInteger, wParam As Long, lParam As Long) As Boolean Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (hWnd As IntPtr, msg As UInteger, wParam As Long, lParam As Long) As Boolean
Public Declare Function SetDllDirectory Lib "kernel32" Alias "SetDllDirectoryA" (lpPathName As String) As Boolean
#End Region #End Region
Public DragControl = Nothing Public DragControl = Nothing
Plain Craft Launcher 2/Modules/ModSecret.vb
+6 -4
View File
@@ -8,10 +8,12 @@ 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 线程优先级
@@ -44,7 +46,7 @@ Friend Module ModSecret
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 的开头
- 更新与联网通知：避免滥用隐患 - 更新与联网通知：避免滥用隐患
- 主题切换：这是需要赞助解锁的纪念性质的功能，别让赞助者太伤心啦…… - 主题切换：这是需要赞助解锁的纪念性质的功能，别让赞助者太伤心啦……
@@ -107,7 +109,7 @@ Friend Module ModSecret
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 & ".pcl2.open.server/"
'如果你有 CurseForge API Key，请添加到 Headers 中，以恢复对 CurseForge 的访问 Client.Headers("x-api-key") = CurseForgeAPIKey
End Sub End Sub
''' <summary> ''' <summary>
''' 设置 Headers 的 UA、Referer。 ''' 设置 Headers 的 UA、Referer。
@@ -121,7 +123,7 @@ Friend Module ModSecret
Request.UserAgent = "PCL2/" & VersionStandardCode Request.UserAgent = "PCL2/" & VersionStandardCode
End If End If
Request.Referer = "http://" & VersionCode & ".pcl2.open.server/" Request.Referer = "http://" & VersionCode & ".pcl2.open.server/"
'如果你有 CurseForge API Key，请添加到 Headers 中，以恢复对 CurseForge 的访问 Request.Headers("x-api-key") = CurseForgeAPIKey
End Sub End Sub
#End Region #End Region
Plain Craft Launcher 2/My Project/AssemblyInfo.vb
+2 -2
View File
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值，也可以使用以下所示的 "*" 预置版本号和修订号 ' 可以指定所有值，也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*” ' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.8.6.0")> <Assembly: AssemblyVersion("2.8.7.0")>
<Assembly: AssemblyFileVersion("2.8.6.0")> <Assembly: AssemblyFileVersion("2.8.7.0")>
<Assembly: NeutralResourcesLanguage("")> <Assembly: NeutralResourcesLanguage("")>
Plain Craft Launcher 2/My Project/Resources.Designer.vb
Generated
+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
Plain Craft Launcher 2/My Project/Resources.resx
+3 -6
View File
@@ -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>
Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb
+8 -8
View File
@@ -28,7 +28,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)
@@ -71,7 +71,7 @@ Public Module ModDownloadLib
VersionFolder = VersionFolder & Id & "\" VersionFolder = VersionFolder & 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 Exit Sub If Behaviour = NetPreDownloadBehaviour.ExitWhileExistsOrDownloading Then Exit Sub
Hint("该版本正在下载中！", HintType.Critical) Hint("该版本正在下载中！", HintType.Critical)
@@ -155,7 +155,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})
@@ -382,7 +382,7 @@ Public Module ModDownloadLib
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
@@ -809,7 +809,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
@@ -843,7 +843,7 @@ Retry:
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
@@ -1025,7 +1025,7 @@ Retry:
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
@@ -1779,7 +1779,7 @@ Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
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
Plain Craft Launcher 2/Pages/PageLaunch/MyMsgLogin.xaml
+40
View File
@@ -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" DeltaMuity="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>
Plain Craft Launcher 2/Pages/PageLaunch/MyMsgLogin.xaml.vb
+139
View File
@@ -0,0 +1,139 @@
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
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(4000)
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("authorization_pending") Then
Thread.Sleep(1000)
ElseIf UnknownFailureCount <= 2 Then
UnknownFailureCount += 1
Log(ex, $"登录轮询第 {UnknownFailureCount} 次失败")
Thread.Sleep(1000)
Else
Finished(New Exception("登录轮询失败", ex))
Return
End If
End Try
Loop
End Sub
End Class
Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb
+2 -2
View File
@@ -130,7 +130,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
@@ -733,7 +733,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
Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml.vb
+4
View File
@@ -106,6 +106,10 @@ Download:
Log("[Page] 主页预设：OpenBMCLAPI 仪表盘 Lite") Log("[Page] 主页预设：OpenBMCLAPI 仪表盘 Lite")
Url = "https://pcl-bmcl.milulu.xyz/" Url = "https://pcl-bmcl.milulu.xyz/"
GoTo Download GoTo Download
Case 7
Log("[Page] 主页预设：主页市场")
Url = "https://homepage-market.pages.dev/Custom.xaml"
GoTo Download
End Select End Select
End Select End Select
RunInUi(Sub() LoadContent(Content)) RunInUi(Sub() LoadContent(Content))
Plain Craft Launcher 2/Pages/PageOther/PageOtherAbout.xaml
+10
View File
@@ -228,6 +228,8 @@
<RowDefinition Height="Auto" /> <RowDefinition Height="Auto" />
<RowDefinition Height="60" /> <RowDefinition Height="60" />
<RowDefinition Height="Auto" /> <RowDefinition Height="Auto" />
<RowDefinition Height="60" />
<RowDefinition Height="Auto" />
</Grid.RowDefinitions> </Grid.RowDefinitions>
<TextBlock Grid.Row="0" Grid.Column="0" Text="Java Launch Wrapper" TextWrapping="Wrap" FontWeight="Bold" /> <TextBlock Grid.Row="0" Grid.Column="0" Text="Java Launch Wrapper" TextWrapping="Wrap" FontWeight="Bold" />
<TextBlock Grid.Row="0" Grid.Column="2" Grid.ColumnSpan="2" Text="Copyright © 2022 00ll00&#xa;Licensed under the MIT License." TextWrapping="Wrap" /> <TextBlock Grid.Row="0" Grid.Column="2" Grid.ColumnSpan="2" Text="Copyright © 2022 00ll00&#xa;Licensed under the MIT License." TextWrapping="Wrap" />
@@ -268,6 +270,14 @@
<TextBlock Grid.Row="10" Grid.Column="2" Grid.ColumnSpan="2" Text="Copyright © ALIMAMA MUX, powered by alimama THX." TextWrapping="Wrap" /> <TextBlock Grid.Row="10" Grid.Column="2" Grid.ColumnSpan="2" Text="Copyright © ALIMAMA MUX, powered by alimama THX." TextWrapping="Wrap" />
<local:MyButton Grid.Row="11" Grid.Column="2" MinWidth="140" Text="查看原网站" Padding="13,0" Margin="0,7,20,18" HorizontalAlignment="Left" <local:MyButton Grid.Row="11" Grid.Column="2" MinWidth="140" Text="查看原网站" Padding="13,0" Margin="0,7,20,18" HorizontalAlignment="Left"
EventType="打开网页" EventData="https://www.iconfont.cn/" /> EventType="打开网页" EventData="https://www.iconfont.cn/" />
<TextBlock Grid.Row="12" Grid.Column="0" Text="libwebp wrapper for .NET" TextWrapping="Wrap" FontWeight="Bold" />
<TextBlock Grid.Row="12" Grid.Column="2" Grid.ColumnSpan="2" Text="Copyright © 2012 Imazen&#xa;Licensed under the MIT License." TextWrapping="Wrap" />
<local:MyButton Grid.Row="13" Grid.Column="2" MinWidth="140" Text="查看来源网站" Padding="13,0" Margin="0,7,20,18" HorizontalAlignment="Left"
EventType="打开网页" EventData="https://github.com/imazen/libwebp-net" />
<local:MyButton Grid.Row="13" Grid.Column="3" MinWidth="140" Text="查看许可文档" Padding="13,0" Margin="0,7,20,18" HorizontalAlignment="Left"
EventType="打开网页" EventData="https://github.com/imazen/libwebp-net/blob/master/LICENSE.txt" />
</Grid> </Grid>
</local:MyCard> </local:MyCard>
</StackPanel> </StackPanel>
Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml.vb
+19 -1
View File
@@ -321,6 +321,11 @@
''' 获取当前设置的 RAM 值。单位为 GB。 ''' 获取当前设置的 RAM 值。单位为 GB。
''' </summary> ''' </summary>
Public Shared Function GetRam(Version As McVersion, UseVersionJavaSetup As Boolean, Optional Is32BitJava As Boolean? = Nothing) As Double Public Shared Function GetRam(Version As McVersion, UseVersionJavaSetup As Boolean, Optional Is32BitJava As Boolean? = Nothing) As Double
'------------------------------------------
' 修改下方代码时需要一并修改 PageVersionSetup
'------------------------------------------
Dim RamGive As Double Dim RamGive As Double
If Setup.Get("LaunchRamType") = 0 Then If Setup.Get("LaunchRamType") = 0 Then
'自动配置 '自动配置
@@ -507,7 +512,7 @@ PreFin:
#End Region #End Region
#Region "启动参数" #Region "其他选项"
Private Sub WindowTypeUIRefresh() Handles ComboArgumentWindowType.SelectionChanged Private Sub WindowTypeUIRefresh() Handles ComboArgumentWindowType.SelectionChanged
If ComboArgumentWindowType Is Nothing Then Exit Sub If ComboArgumentWindowType Is Nothing Then Exit Sub
@@ -545,6 +550,19 @@ PreFin:
End If End If
End Sub End Sub
'版本隔离警告
Private Sub ComboArgumentIndie_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboArgumentIndie.SelectionChanged
If AniControlEnabled <> 0 Then Exit Sub
If MyMsgBox("调整版本隔离后，你可能得把游戏存档、Mod 等文件手动迁移到新的游戏文件夹中。" & vbCrLf &
"如果修改后发现存档消失，把这项设置改回来就能恢复。" & vbCrLf &
"如果你不会迁移存档，不建议修改这项设置！",
"警告", "我知道我在做什么", "取消", IsWarn:=True) = 2 Then
AniControlEnabled += 1
ComboArgumentIndie.SelectedItem = e.RemovedItems(0)
AniControlEnabled -= 1
End If
End Sub
#End Region #End Region
#Region "高级设置" #Region "高级设置"
Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml.vb
+14 -16
View File
@@ -170,26 +170,24 @@
End Sub End Sub
'自动更新 '自动更新
Private Sub ComboSystemActivity_SizeChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboSystemActivity.SelectionChanged Private Sub ComboSystemActivity_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboSystemActivity.SelectionChanged
If AniControlEnabled <> 0 Then Exit Sub If AniControlEnabled <> 0 Then Exit Sub
If ComboSystemActivity.SelectedIndex = 2 Then If ComboSystemActivity.SelectedIndex <> 2 Then Exit Sub
If MyMsgBox("若选择此项，即使在将来出现严重问题时，你也无法获取相关通知。" & vbCrLf & If MyMsgBox("若选择此项，即使在将来出现严重问题时，你也无法获取相关通知。" & vbCrLf &
"例如，如果发现某个版本游戏存在严重 Bug，你可能就会因为无法得到通知而导致无法预知的后果。" & vbCrLf & vbCrLf & "例如，如果发现某个版本游戏存在严重 Bug，你可能就会因为无法得到通知而导致无法预知的后果。" & vbCrLf & vbCrLf &
"一般选择 仅在有重要通知时显示公告 就可以让你尽量不受打扰了。" & vbCrLf & "一般选择 仅在有重要通知时显示公告 就可以让你尽量不受打扰了。" & vbCrLf &
"除非你在制作服务器整合包，或时常手动更新启动器，否则极度不推荐选择此项！", "警告", "我知道我在做什么", "取消", IsWarn:=True) = 2 Then "除非你在制作服务器整合包，或时常手动更新启动器，否则极度不推荐选择此项！", "警告", "我知道我在做什么", "取消", IsWarn:=True) = 2 Then
ComboSystemActivity.SelectedItem = e.RemovedItems(0) ComboSystemActivity.SelectedItem = e.RemovedItems(0)
End If
End If End If
End Sub End Sub
Private Sub ComboSystemUpdate_SizeChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboSystemUpdate.SelectionChanged Private Sub ComboSystemUpdate_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboSystemUpdate.SelectionChanged
If AniControlEnabled <> 0 Then Exit Sub If AniControlEnabled <> 0 Then Exit Sub
If ComboSystemUpdate.SelectedIndex = 3 Then If ComboSystemUpdate.SelectedIndex <> 3 Then Exit Sub
If MyMsgBox("若选择此项，即使在启动器将来出现严重问题时，你也无法获取更新并获得修复。" & vbCrLf & If MyMsgBox("若选择此项，即使在启动器将来出现严重问题时，你也无法获取更新并获得修复。" & vbCrLf &
"例如，如果官方修改了登录方式，从而导致现有启动器无法登录，你可能就会因为无法更新而无法开始游戏。" & vbCrLf & vbCrLf & "例如，如果官方修改了登录方式，从而导致现有启动器无法登录，你可能就会因为无法更新而无法开始游戏。" & vbCrLf & vbCrLf &
"一般选择 仅在有重大漏洞更新时显示提示 就可以让你尽量不受打扰了。" & vbCrLf & "一般选择 仅在有重大漏洞更新时显示提示 就可以让你尽量不受打扰了。" & vbCrLf &
"除非你在制作服务器整合包，或时常手动更新启动器，否则极度不推荐选择此项！", "警告", "我知道我在做什么", "取消", IsWarn:=True) = 2 Then "除非你在制作服务器整合包，或时常手动更新启动器，否则极度不推荐选择此项！", "警告", "我知道我在做什么", "取消", IsWarn:=True) = 2 Then
ComboSystemUpdate.SelectedItem = e.RemovedItems(0) ComboSystemUpdate.SelectedItem = e.RemovedItems(0)
End If
End If End If
End Sub End Sub
Private Sub BtnSystemUpdate_Click(sender As Object, e As EventArgs) Handles BtnSystemUpdate.Click Private Sub BtnSystemUpdate_Click(sender As Object, e As EventArgs) Handles BtnSystemUpdate.Click
Plain Craft Launcher 2/Pages/PageSetup/PageSetupUI.xaml
+1
View File
@@ -243,6 +243,7 @@
<local:MyComboBoxItem Content="每日整合包推荐（作者：wkea）" /> <local:MyComboBoxItem Content="每日整合包推荐（作者：wkea）" />
<local:MyComboBoxItem Content="Minecraft 皮肤推荐（作者：wkea）" /> <local:MyComboBoxItem Content="Minecraft 皮肤推荐（作者：wkea）" />
<local:MyComboBoxItem Content="OpenBMCLAPI 仪表盘 Lite（作者：Silverteal、Mxmilu666）" /> <local:MyComboBoxItem Content="OpenBMCLAPI 仪表盘 Lite（作者：Silverteal、Mxmilu666）" />
<local:MyComboBoxItem Content="PCL 主页市场（作者：凌云）" />
</local:MyComboBox> </local:MyComboBox>
</Grid> </Grid>
</StackPanel> </StackPanel>
Plain Craft Launcher 2/Pages/PageSetup/PageSetupUI.xaml.vb
+1 -1
View File
@@ -662,7 +662,7 @@ Refresh:
#End Region #End Region
'公开预览版 '赞助
Private Sub BtnLauncherDonate_Click(sender As Object, e As EventArgs) Handles BtnLauncherDonate.Click Private Sub BtnLauncherDonate_Click(sender As Object, e As EventArgs) Handles BtnLauncherDonate.Click
OpenWebsite("https://afdian.com/a/LTCat") OpenWebsite("https://afdian.com/a/LTCat")
End Sub End Sub
Plain Craft Launcher 2/Pages/PageSpeedLeft.xaml.vb
+9 -13
View File
@@ -92,15 +92,12 @@ Public Class PageSpeedLeft
Card.Children.Add(GetObjectFromXML("<Path xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" Stretch=""Uniform"" Tag=""Failed"" Data=""F1 M2.5,0 L0,2.5 7.5,10 0,17.5 2.5,20 10,12.5 17.5,20 20,17.5 12.5,10 20,2.5 17.5,0 10,7.5 2.5,0Z"" Height=""15"" Width=""15"" HorizontalAlignment=""Center"" Grid.Column=""0"" Grid.Row=""0"" Fill=""{DynamicResource ColorBrush3}"" Margin=""0,1,0,0"" VerticalAlignment=""Top""/>")) Card.Children.Add(GetObjectFromXML("<Path xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" Stretch=""Uniform"" Tag=""Failed"" Data=""F1 M2.5,0 L0,2.5 7.5,10 0,17.5 2.5,20 10,12.5 17.5,20 20,17.5 12.5,10 20,2.5 17.5,0 10,7.5 2.5,0Z"" Height=""15"" Width=""15"" HorizontalAlignment=""Center"" Grid.Column=""0"" Grid.Row=""0"" Fill=""{DynamicResource ColorBrush3}"" Margin=""0,1,0,0"" VerticalAlignment=""Top""/>"))
Dim Tb As TextBlock = GetObjectFromXML("<TextBlock xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" TextWrapping=""Wrap"" HorizontalAlignment=""Left"" ToolTip=""单击复制错误详情"" Grid.Column=""1"" Grid.Row=""0"" Margin=""0,0,0,5"" />") Dim Tb As TextBlock = GetObjectFromXML("<TextBlock xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation"" TextWrapping=""Wrap"" HorizontalAlignment=""Left"" ToolTip=""单击复制错误详情"" Grid.Column=""1"" Grid.Row=""0"" Margin=""0,0,0,5"" />")
Tb.Text = GetExceptionDetail(Loader.Error) Tb.Text = GetExceptionDetail(Loader.Error)
AddHandler Tb.MouseLeftButtonDown, Sub(sender As TextBlock, e As EventArgs) AddHandler Tb.MouseLeftButtonDown,
ClipboardSet(sender.Text, False) Sub(sender As TextBlock, e As EventArgs)
Hint("已复制错误详情！", HintType.Finish) ClipboardSet(sender.Text, False)
End Sub Hint("已复制错误详情！", HintType.Finish)
End Sub
Card.Children.Add(Tb) Card.Children.Add(Tb)
''删除取消按钮
'For Each Element As FrameworkElement In CType(Card.Parent, Panel).Children
' If Element.Name = "BtnCancel" Then AniDispose(CType(Element, MyIconButton), True)
'Next
#End Region #End Region
Case LoadState.Finished Case LoadState.Finished
#Region "完成，销毁卡片并返回" #Region "完成，销毁卡片并返回"
@@ -195,11 +192,10 @@ Public Class PageSpeedLeft
Sub(sender As MyIconButton, e As EventArgs) Sub(sender As MyIconButton, e As EventArgs)
AniDispose(sender, False) AniDispose(sender, False)
AniDispose(Card, True, Sub() If FrmSpeedRight.PanMain.Children.Count = 0 AndAlso FrmMain.PageCurrent = FormMain.PageType.DownloadManager Then FrmMain.PageBack()) AniDispose(Card, True, Sub() If FrmSpeedRight.PanMain.Children.Count = 0 AndAlso FrmMain.PageCurrent = FormMain.PageType.DownloadManager Then FrmMain.PageBack())
Dim LoaderName = If(Loader Is Nothing, "null", Loader.Name) RightCards.Remove(Loader.Name)
RightCards.Remove(LoaderName) LoaderTaskbar.Remove(Loader)
LoaderTaskbar.TryTake(Loader) Log($"[Taskbar] 关闭下载管理卡片：{Loader.Name}，且移出任务列表")
Log($"[Taskbar] 关闭下载管理卡片：{LoaderName}，且移出任务列表") RunInThread(Sub() Loader.Abort())
RunInThread(Sub() Loader?.Abort())
End Sub End Sub
'如果已经失败，再刷新一次，修改成失败的控件 '如果已经失败，再刷新一次，修改成失败的控件
If Loader.State = LoadState.Failed Then If Loader.State = LoadState.Failed Then
Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml.vb
+17 -16
View File
@@ -121,7 +121,7 @@
ToolTipService.SetVerticalOffset(BtnED, 30) ToolTipService.SetVerticalOffset(BtnED, 30)
ToolTipService.SetHorizontalOffset(BtnED, 2) ToolTipService.SetHorizontalOffset(BtnED, 2)
AddHandler BtnED.Click, AddressOf ED_Click AddHandler BtnED.Click, AddressOf ED_Click
If sender.Entry.State = McMod.McModState.Unavaliable Then If sender.Entry.State = McMod.McModState.Unavailable Then
sender.Buttons = {BtnCont, BtnOpen, BtnDelete} sender.Buttons = {BtnCont, BtnOpen, BtnDelete}
Else Else
sender.Buttons = {BtnCont, BtnOpen, BtnED, BtnDelete} sender.Buttons = {BtnCont, BtnOpen, BtnED, BtnDelete}
@@ -171,22 +171,18 @@
If ModItem.CanUpdate Then UpdateCount += 1 If ModItem.CanUpdate Then UpdateCount += 1
If ModItem.State.Equals(McMod.McModState.Fine) Then EnabledCount += 1 If ModItem.State.Equals(McMod.McModState.Fine) Then EnabledCount += 1
If ModItem.State.Equals(McMod.McModState.Disabled) Then DisabledCount += 1 If ModItem.State.Equals(McMod.McModState.Disabled) Then DisabledCount += 1
If ModItem.State.Equals(McMod.McModState.Unavaliable) Then UnavalialeCount += 1 If ModItem.State.Equals(McMod.McModState.Unavailable) Then UnavalialeCount += 1
Next Next
'显示 '显示
BtnFilterAll.Text = If(IsSearching, "搜索结果", "全部") & $" ({AnyCount})" BtnFilterAll.Text = If(IsSearching, "搜索结果", "全部") & $" ({AnyCount})"
BtnFilterCanUpdate.Text = $"可更新 ({UpdateCount})" BtnFilterCanUpdate.Text = $"可更新 ({UpdateCount})"
BtnFilterCanUpdate.Visibility = If(Filter = FilterType.CanUpdate OrElse BtnFilterCanUpdate.Visibility = If(Filter = FilterType.CanUpdate OrElse UpdateCount > 0, Visibility.Visible, Visibility.Collapsed)
UpdateCount > 0, Visibility.Visible, Visibility.Collapsed)
BtnFilterEnabled.Text = $"启用 ({EnabledCount})" BtnFilterEnabled.Text = $"启用 ({EnabledCount})"
BtnFilterEnabled.Visibility = If(Filter = FilterType.Enabled OrElse Filter = FilterType.Disabled OrElse BtnFilterEnabled.Visibility = If(Filter = FilterType.Enabled OrElse (EnabledCount > 0 AndAlso EnabledCount < AnyCount), Visibility.Visible, Visibility.Collapsed)
EnabledCount > 0 AndAlso EnabledCount <> AnyCount, Visibility.Visible, Visibility.Collapsed)
BtnFilterDisabled.Text = $"禁用 ({DisabledCount})" BtnFilterDisabled.Text = $"禁用 ({DisabledCount})"
BtnFilterDisabled.Visibility = If(Filter = FilterType.Enabled OrElse Filter = FilterType.Disabled OrElse BtnFilterDisabled.Visibility = If(Filter = FilterType.Disabled OrElse DisabledCount > 0, Visibility.Visible, Visibility.Collapsed)
DisabledCount > 0, Visibility.Visible, Visibility.Collapsed)
BtnFilterError.Text = $"错误 ({UnavalialeCount})" BtnFilterError.Text = $"错误 ({UnavalialeCount})"
BtnFilterError.Visibility = If(Filter = FilterType.Unavaliable OrElse BtnFilterError.Visibility = If(Filter = FilterType.Unavailable OrElse UnavalialeCount > 0, Visibility.Visible, Visibility.Collapsed)
UnavalialeCount > 0, Visibility.Visible, Visibility.Collapsed)
'----------------- '-----------------
' 底部栏 ' 底部栏
@@ -382,7 +378,7 @@
Enabled = 1 Enabled = 1
Disabled = 2 Disabled = 2
CanUpdate = 3 CanUpdate = 3
Unavaliable = 4 Unavailable = 4
End Enum End Enum
''' <summary> ''' <summary>
@@ -406,8 +402,8 @@
Return CheckingMod.State = McMod.McModState.Disabled Return CheckingMod.State = McMod.McModState.Disabled
Case FilterType.CanUpdate Case FilterType.CanUpdate
Return CheckingMod.CanUpdate Return CheckingMod.CanUpdate
Case FilterType.Unavaliable Case FilterType.Unavailable
Return CheckingMod.State = McMod.McModState.Unavaliable Return CheckingMod.State = McMod.McModState.Unavailable
Case Else Case Else
Return False Return False
End Select End Select
@@ -492,7 +488,10 @@
'更新 '更新
Private Sub BtnSelectUpdate_Click() Handles BtnSelectUpdate.Click Private Sub BtnSelectUpdate_Click() Handles BtnSelectUpdate.Click
UpdateMods(McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.RawFileName) AndAlso m.CanUpdate)) Dim UpdateList As List(Of McMod) = McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.RawFileName) AndAlso m.CanUpdate).ToList()
If Not UpdateList.Any() Then Return
UpdateMods(UpdateList)
ChangeAllSelected(False)
End Sub End Sub
''' <summary> ''' <summary>
''' 记录正在进行 Mod 更新的 mods 文件夹路径。 ''' 记录正在进行 Mod 更新的 mods 文件夹路径。
@@ -583,6 +582,7 @@
Case Else Case Else
Exit Sub Exit Sub
End Select End Select
Log($"[Mod] 已从正在进行 Mod 更新的文件夹列表移除：{PathMods}")
UpdatingVersions.Remove(PathMods) UpdatingVersions.Remove(PathMods)
'清理缓存 '清理缓存
RunInNewThread( RunInNewThread(
@@ -597,7 +597,7 @@
End Sub, "Clean Mod Update Cache", ThreadPriority.BelowNormal) End Sub, "Clean Mod Update Cache", ThreadPriority.BelowNormal)
End Sub End Sub
'启动加载器 '启动加载器
Log($"[Mod] 开始更新 {ModList.Count} 个 Mod") Log($"[Mod] 开始更新 {ModList.Count} 个 Mod：{PathMods}")
UpdatingVersions.Add(PathMods) UpdatingVersions.Add(PathMods)
Loader.Start() Loader.Start()
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
@@ -612,6 +612,7 @@
'删除 '删除
Private Sub BtnSelectDelete_Click() Handles BtnSelectDelete.Click Private Sub BtnSelectDelete_Click() Handles BtnSelectDelete.Click
DeleteMods(McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.RawFileName))) DeleteMods(McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.RawFileName)))
ChangeAllSelected(False)
End Sub End Sub
Private Sub DeleteMods(ModList As IEnumerable(Of McMod)) Private Sub DeleteMods(ModList As IEnumerable(Of McMod))
Try Try
@@ -700,7 +701,7 @@
Dim ModEntry As McMod = CType(If(TypeOf sender Is MyIconButton, sender.Tag, sender), MyLocalModItem).Entry Dim ModEntry As McMod = CType(If(TypeOf sender Is MyIconButton, sender.Tag, sender), MyLocalModItem).Entry
'加载失败信息 '加载失败信息
If ModEntry.State = McMod.McModState.Unavaliable Then If ModEntry.State = McMod.McModState.Unavailable Then
MyMsgBox("无法读取此 Mod 的信息。" & vbCrLf & vbCrLf & "详细的错误信息：" & GetExceptionDetail(ModEntry.FileUnavailableReason), "Mod 读取失败") MyMsgBox("无法读取此 Mod 的信息。" & vbCrLf & vbCrLf & "详细的错误信息：" & GetExceptionDetail(ModEntry.FileUnavailableReason), "Mod 读取失败")
Return Return
End If End If
Plain Craft Launcher 2/Pages/PageVersion/PageVersionOverall.xaml.vb
+10 -1
View File
@@ -283,6 +283,15 @@
'补全文件 '补全文件
Private Sub BtnManageCheck_Click(sender As Object, e As EventArgs) Handles BtnManageCheck.Click Private Sub BtnManageCheck_Click(sender As Object, e As EventArgs) Handles BtnManageCheck.Click
Try Try
'忽略文件检查提示
If ShouldIgnoreFileCheck(PageVersionLeft.Version) Then
If Setup.Get("LaunchAdvanceAssets") Then
Hint("请先关闭 [设置 → 高级启动选项 → 关闭文件校验]，然后再尝试补全文件！", HintType.Info)
Else
Hint("请先关闭 [版本设置 → 设置 → 高级启动选项 → 关闭文件校验]，然后再尝试补全文件！", HintType.Info)
End If
Exit Sub
End If
'重复任务检查 '重复任务检查
For Each OngoingLoader In LoaderTaskbar For Each OngoingLoader In LoaderTaskbar
If OngoingLoader.Name <> PageVersionLeft.Version.Name & " 文件补全" Then Continue For If OngoingLoader.Name <> PageVersionLeft.Version.Name & " 文件补全" Then Continue For
@@ -290,7 +299,7 @@
Exit Sub Exit Sub
Next Next
'启动 '启动
Dim Loader As New LoaderCombo(Of String)(PageVersionLeft.Version.Name & " 文件补全", DlClientFix(PageVersionLeft.Version, True, AssetsIndexExistsBehaviour.AlwaysDownload, False)) Dim Loader As New LoaderCombo(Of String)(PageVersionLeft.Version.Name & " 文件补全", DlClientFix(PageVersionLeft.Version, True, AssetsIndexExistsBehaviour.AlwaysDownload))
Loader.OnStateChanged = Loader.OnStateChanged =
Sub() Sub()
Select Case Loader.State Select Case Loader.State
Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml.vb
+41 -23
View File
@@ -282,6 +282,11 @@
If Setup.Get("VersionRamType", Version:=Version) = 2 Then If Setup.Get("VersionRamType", Version:=Version) = 2 Then
Return PageSetupLaunch.GetRam(Version, True, Is32BitJava) Return PageSetupLaunch.GetRam(Version, True, Is32BitJava)
End If End If
'------------------------------------------
' 修改下方代码时需要一并修改 PageSetupLaunch
'------------------------------------------
'使用当前版本的设置 '使用当前版本的设置
Dim RamGive As Double Dim RamGive As Double
If Setup.Get("VersionRamType", Version:=Version) = 0 Then If Setup.Get("VersionRamType", Version:=Version) = 0 Then
@@ -297,19 +302,19 @@
'可安装 Mod 的版本 '可安装 Mod 的版本
Dim ModDir As New DirectoryInfo(Version.PathIndie & "mods\") Dim ModDir As New DirectoryInfo(Version.PathIndie & "mods\")
Dim ModCount As Integer = If(ModDir.Exists, ModDir.GetFiles.Length, 0) Dim ModCount As Integer = If(ModDir.Exists, ModDir.GetFiles.Length, 0)
RamMininum = 0.4 + ModCount / 150 RamMininum = 0.5 + ModCount / 150
RamTarget1 = 1.5 + ModCount / 100 RamTarget1 = 1.5 + ModCount / 90
RamTarget2 = 3 + ModCount / 60 RamTarget2 = 2.7 + ModCount / 50
RamTarget3 = 6 + ModCount / 30 RamTarget3 = 4.5 + ModCount / 25
ElseIf Version IsNot Nothing AndAlso Version.Version.HasOptiFine Then ElseIf Version IsNot Nothing AndAlso Version.Version.HasOptiFine Then
'OptiFine 版本 'OptiFine 版本
RamMininum = 0.3 RamMininum = 0.5
RamTarget1 = 1.5 RamTarget1 = 1.5
RamTarget2 = 3 RamTarget2 = 3
RamTarget3 = 6 RamTarget3 = 5
Else Else
'普通版本 '普通版本
RamMininum = 0.3 RamMininum = 0.5
RamTarget1 = 1.5 RamTarget1 = 1.5
RamTarget2 = 2.5 RamTarget2 = 2.5
RamTarget3 = 4 RamTarget3 = 4
@@ -317,27 +322,23 @@
Dim RamDelta As Double Dim RamDelta As Double
'预分配内存，阶段一，0 ~ T1，100% '预分配内存，阶段一，0 ~ T1，100%
RamDelta = RamTarget1 RamDelta = RamTarget1
RamAvailable = Math.Max(0, RamAvailable - 0.1) RamGive += Math.Min(RamAvailable, RamDelta)
RamGive += Math.Min(RamAvailable * 1, RamDelta) RamAvailable -= RamDelta
RamAvailable -= RamDelta / 1 + 0.1
If RamAvailable < 0.1 Then GoTo PreFin If RamAvailable < 0.1 Then GoTo PreFin
'预分配内存，阶段二，T1 ~ T2，80% '预分配内存，阶段二，T1 ~ T2，70%
RamDelta = RamTarget2 - RamTarget1 RamDelta = RamTarget2 - RamTarget1
RamAvailable = Math.Max(0, RamAvailable - 0.1) RamGive += Math.Min(RamAvailable * 0.7, RamDelta)
RamGive += Math.Min(RamAvailable * 0.8, RamDelta) RamAvailable -= RamDelta / 0.7
RamAvailable -= RamDelta / 0.8 + 0.1
If RamAvailable < 0.1 Then GoTo PreFin If RamAvailable < 0.1 Then GoTo PreFin
'预分配内存，阶段三，T2 ~ T3，60% '预分配内存，阶段三，T2 ~ T3，40%
RamDelta = RamTarget3 - RamTarget2 RamDelta = RamTarget3 - RamTarget2
RamAvailable = Math.Max(0, RamAvailable - 0.2)
RamGive += Math.Min(RamAvailable * 0.6, RamDelta)
RamAvailable -= RamDelta / 0.6 + 0.2
If RamAvailable < 0.1 Then GoTo PreFin
'预分配内存，阶段四，T3 ~ T3 * 2，40%
RamDelta = RamTarget3
RamAvailable = Math.Max(0, RamAvailable - 0.3)
RamGive += Math.Min(RamAvailable * 0.4, RamDelta) RamGive += Math.Min(RamAvailable * 0.4, RamDelta)
RamAvailable -= RamDelta / 0.4 + 0.3 RamAvailable -= RamDelta / 0.4
If RamAvailable < 0.1 Then GoTo PreFin
'预分配内存，阶段四，T3 ~ T3 * 2，15%
RamDelta = RamTarget3
RamGive += Math.Min(RamAvailable * 0.15, RamDelta)
RamAvailable -= RamDelta / 0.15
If RamAvailable < 0.1 Then GoTo PreFin If RamAvailable < 0.1 Then GoTo PreFin
PreFin: PreFin:
'不低于最低值 '不低于最低值
@@ -484,6 +485,23 @@ PreFin:
#End Region #End Region
#Region "其他设置"
'版本隔离警告
Private Sub ComboArgumentIndie_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles ComboArgumentIndie.SelectionChanged
If AniControlEnabled <> 0 Then Exit Sub
If MyMsgBox("调整版本隔离后，你可能得把游戏存档、Mod 等文件手动迁移到新的游戏文件夹中。" & vbCrLf &
"如果修改后发现存档消失，把这项设置改回来就能恢复。" & vbCrLf &
"如果你不会迁移存档，不建议修改这项设置！",
"警告", "我知道我在做什么", "取消", IsWarn:=True) = 2 Then
AniControlEnabled += 1
ComboArgumentIndie.SelectedItem = e.RemovedItems(0)
AniControlEnabled -= 1
End If
End Sub
#End Region
#Region "高级设置" #Region "高级设置"
Private Sub TextAdvanceRun_TextChanged(sender As Object, e As TextChangedEventArgs) Handles TextAdvanceRun.TextChanged Private Sub TextAdvanceRun_TextChanged(sender As Object, e As TextChangedEventArgs) Handles TextAdvanceRun.TextChanged
Plain Craft Launcher 2/Plain Craft Launcher 2.vbproj
+19 -24
View File
@@ -143,6 +143,7 @@
<Reference Include="Imazen.WebP, Version=10.0.1.0, Culture=neutral, processorArchitecture=MSIL"> <Reference Include="Imazen.WebP, Version=10.0.1.0, Culture=neutral, processorArchitecture=MSIL">
<SpecificVersion>False</SpecificVersion> <SpecificVersion>False</SpecificVersion>
<HintPath>Resources\Imazen.WebP.dll</HintPath> <HintPath>Resources\Imazen.WebP.dll</HintPath>
<Private>False</Private>
</Reference> </Reference>
<Reference Include="NAudio, Version=1.7.3.0, Culture=neutral, processorArchitecture=MSIL"> <Reference Include="NAudio, Version=1.7.3.0, Culture=neutral, processorArchitecture=MSIL">
<SpecificVersion>False</SpecificVersion> <SpecificVersion>False</SpecificVersion>
@@ -164,6 +165,7 @@
<Reference Include="System.Management" /> <Reference Include="System.Management" />
<Reference Include="System.Net.Http" /> <Reference Include="System.Net.Http" />
<Reference Include="System.Numerics" /> <Reference Include="System.Numerics" />
<Reference Include="System.ServiceModel" />
<Reference Include="System.Windows.Forms" /> <Reference Include="System.Windows.Forms" />
<Reference Include="System.Xml.Linq" /> <Reference Include="System.Xml.Linq" />
<Reference Include="System" /> <Reference Include="System" />
@@ -189,6 +191,9 @@
<Compile Include="Controls\MyIconTextButton.xaml.vb"> <Compile Include="Controls\MyIconTextButton.xaml.vb">
<DependentUpon>MyIconTextButton.xaml</DependentUpon> <DependentUpon>MyIconTextButton.xaml</DependentUpon>
</Compile> </Compile>
<Compile Include="Modules\Minecraft\ModComp.vb" /> <Compile Include="Modules\Minecraft\ModComp.vb" />
<Compile Include="Modules\Minecraft\ModJava.vb" /> <Compile Include="Modules\Minecraft\ModJava.vb" />
<Compile Include="Modules\Minecraft\ModMod.vb" /> <Compile Include="Modules\Minecraft\ModMod.vb" />
@@ -254,6 +259,9 @@
<Compile Include="Pages\PageLaunch\FormLoginOAuth.xaml.vb"> <Compile Include="Pages\PageLaunch\FormLoginOAuth.xaml.vb">
<DependentUpon>FormLoginOAuth.xaml</DependentUpon> <DependentUpon>FormLoginOAuth.xaml</DependentUpon>
</Compile> </Compile>
<Compile Include="Pages\PageLaunch\MyMsgLogin.xaml.vb">
<DependentUpon>MyMsgLogin.xaml</DependentUpon>
</Compile>
<Compile Include="Pages\PageLaunch\PageLoginAuth.xaml.vb"> <Compile Include="Pages\PageLaunch\PageLoginAuth.xaml.vb">
<DependentUpon>PageLoginAuth.xaml</DependentUpon> <DependentUpon>PageLoginAuth.xaml</DependentUpon>
</Compile> </Compile>
@@ -473,6 +481,7 @@
<DependentUpon>FormMain.xaml</DependentUpon> <DependentUpon>FormMain.xaml</DependentUpon>
<SubType>Code</SubType> <SubType>Code</SubType>
</Compile> </Compile>
<Page Include="Modules\Minecraft\MyLocalModItem.xaml"> <Page Include="Modules\Minecraft\MyLocalModItem.xaml">
<Generator>MSBuild:Compile</Generator> <Generator>MSBuild:Compile</Generator>
<SubType>Designer</SubType> <SubType>Designer</SubType>
@@ -509,6 +518,10 @@
<SubType>Designer</SubType> <SubType>Designer</SubType>
<Generator>MSBuild:Compile</Generator> <Generator>MSBuild:Compile</Generator>
</Page> </Page>
<Page Include="Pages\PageLaunch\MyMsgLogin.xaml">
<Generator>MSBuild:Compile</Generator>
<SubType>Designer</SubType>
</Page>
<Page Include="Pages\PageLaunch\PageLoginAuth.xaml"> <Page Include="Pages\PageLaunch\PageLoginAuth.xaml">
<Generator>MSBuild:Compile</Generator> <Generator>MSBuild:Compile</Generator>
<SubType>Designer</SubType> <SubType>Designer</SubType>
@@ -881,26 +894,6 @@
<ItemGroup> <ItemGroup>
<WCFMetadata Include="Connected Services\" /> <WCFMetadata Include="Connected Services\" />
</ItemGroup> </ItemGroup>
<ItemGroup>
<COMReference Include="NATUPNPLib">
<Guid>{1C565858-F302-471E-B409-F180AA4ABEC6}</Guid>
<VersionMajor>1</VersionMajor>
<VersionMinor>0</VersionMinor>
<Lcid>0</Lcid>
<WrapperTool>tlbimp</WrapperTool>
<Isolated>False</Isolated>
<EmbedInteropTypes>True</EmbedInteropTypes>
</COMReference>
<COMReference Include="NetFwTypeLib">
<Guid>{58FBCF7C-E7A9-467C-80B3-FC65E8FCCA08}</Guid>
<VersionMajor>1</VersionMajor>
<VersionMinor>0</VersionMinor>
<Lcid>0</Lcid>
<WrapperTool>tlbimp</WrapperTool>
<Isolated>False</Isolated>
<EmbedInteropTypes>True</EmbedInteropTypes>
</COMReference>
</ItemGroup>
<ItemGroup> <ItemGroup>
<Resource Include="Images\Blocks\OptiFabric.png" /> <Resource Include="Images\Blocks\OptiFabric.png" />
</ItemGroup> </ItemGroup>
@@ -921,15 +914,13 @@
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<Resource Include="Images\Icons\Disabled.png" /> <Resource Include="Images\Icons\Disabled.png" />
<Resource Include="Images\Icons\Unavaliable.png" /> <Resource Include="Images\Icons\Unavailable.png" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<Resource Include="Images\Heads\MCBBS.png" /> <Resource Include="Images\Heads\MCBBS.png" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<Content Include="Resources\Imazen.WebP.dll" />
<Content Include="Resources\libwebp32.dll" />
<Content Include="Resources\libwebp64.dll" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<Resource Include="Images\Blocks\NeoForge.png" /> <Resource Include="Images\Blocks\NeoForge.png" />
@@ -937,5 +928,9 @@
<ItemGroup> <ItemGroup>
<Resource Include="Images\Heads\z0z0r4.png" /> <Resource Include="Images\Heads\z0z0r4.png" />
</ItemGroup> </ItemGroup>
<ItemGroup>
<None Include="Resources\Imazen.WebP.dll" />
<None Include="Resources\libwebp64.dll" />
</ItemGroup>
<Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" /> <Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
</Project> </Project>
Plain Craft Launcher 2/Resources/libwebp32.dll
BIN
View File
Binary file not shown.