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

2.7.2

Browse Source
This commit is contained in:
龙腾猫跃
2024-05-13 18:09:30 +08:00
parent a5a3800957
commit a84601d99c
33 changed files with 764 additions and 774 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Plain Craft Launcher 2/Application.xaml.vb
+9 -9
View File
@@ -19,7 +19,6 @@ Public Class Application
'开始
Private Sub Application_Startup(sender As Object, e As StartupEventArgs) Handles Me.Startup
ApplicationStartTick = GetTimeTick()
SecretOnApplicationStart()
Try
'检查参数调用
@@ -104,9 +103,10 @@ Public Class Application
'日志初始化
LogStart()
'添加日志
Log("[Start] 程序版本：" & VersionDisplayName & "（" & VersionCode & "）")
Log("[Start] 识别码：" & UniqueAddress & If(ThemeCheckOne(9), "，已解锁反馈主题", ""))
Log("[Start] 程序路径：" & PathWithName)
Log($"[Start] 程序版本：{VersionDisplayName} ({VersionCode})")
Log($"[Start] 识别码：{UniqueAddress}{If(ThemeCheckOne(9), "，已解锁反馈主题", "")}")
Log($"[Start] 程序路径：{PathWithName}")
Log($"[Start] 系统编码：{Encoding.Default} ({Encoding.Default.CodePage}, GBK={IsGBKEncoding})")
'检测压缩包运行
If Path.Contains(IO.Path.GetTempPath()) OrElse Path.Contains("AppData\Local\Temp\") Then
MyMsgBox("PCL 正在临时文件夹运行，设置、游戏存档等很可能无法保存，且部分功能会无法使用或出错。" & vbCrLf & "请将 PCL 从压缩文件中解压，或是更换文件夹后再继续使用！", "环境警告", "我知道了", IsWarn:=True)
@@ -220,7 +220,7 @@ Public Class Application
Names.Remove(sender.Tag)
Setup.Set("LoginLegacyName", Join(Names, "¨"))
FrmLoginLegacy.ComboName.ItemsSource = Names
FrmLoginLegacy.ComboName.Text = If(Names.Count > 0, Names(0), "")
FrmLoginLegacy.ComboName.Text = If(Names.Any, Names(0), "")
Case Else
'第三方
Dim Token As String = GetStringFromEnum(Setup.Get("LoginType"))
@@ -238,12 +238,12 @@ Public Class Application
Select Case Token
Case "Nide"
FrmLoginNide.ComboName.ItemsSource = Dict.Keys
FrmLoginNide.ComboName.Text = If(Dict.Keys.Count > 0, Dict.Keys(0), "")
FrmLoginNide.TextPass.Password = If(Dict.Values.Count > 0, Dict.Values(0), "")
FrmLoginNide.ComboName.Text = If(Dict.Keys.Any, Dict.Keys(0), "")
FrmLoginNide.TextPass.Password = If(Dict.Values.Any, Dict.Values(0), "")
Case "Auth"
FrmLoginAuth.ComboName.ItemsSource = Dict.Keys
FrmLoginAuth.ComboName.Text = If(Dict.Keys.Count > 0, Dict.Keys(0), "")
FrmLoginAuth.TextPass.Password = If(Dict.Values.Count > 0, Dict.Values(0), "")
FrmLoginAuth.ComboName.Text = If(Dict.Keys.Any, Dict.Keys(0), "")
FrmLoginAuth.TextPass.Password = If(Dict.Values.Any, Dict.Values(0), "")
End Select
End Select
End Sub
Plain Craft Launcher 2/Controls/MyScrollViewer.vb
+6 -4
View File
@@ -8,10 +8,12 @@
Private Sub MyScrollViewer_PreviewMouseWheel(sender As Object, e As MouseWheelEventArgs) Handles Me.PreviewMouseWheel
If e.Delta = 0 OrElse ActualHeight = 0 OrElse ScrollableHeight = 0 Then Exit Sub
Dim SourceType = e.Source.GetType
If Content.TemplatedParent Is Nothing AndAlso
((GetType(ComboBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, ComboBox).IsDropDownOpen) OrElse
(GetType(TextBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, TextBox).AcceptsReturn) OrElse
GetType(ComboBoxItem).IsAssignableFrom(SourceType)) Then
If Content.TemplatedParent Is Nothing AndAlso (
(GetType(ComboBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, ComboBox).IsDropDownOpen) OrElse
(GetType(TextBox).IsAssignableFrom(SourceType) AndAlso CType(e.Source, TextBox).AcceptsReturn) OrElse
GetType(ComboBoxItem).IsAssignableFrom(SourceType) OrElse
TypeOf e.Source Is CheckBox
) Then
'如果当前是在对有滚动条的下拉框或文本框执行，则不接管操作
Exit Sub
End If
Plain Craft Launcher 2/FormMain.xaml.vb
+31 -15
View File
@@ -10,6 +10,10 @@ Public Class FormMain
Dim FeatureList As New List(Of KeyValuePair(Of Integer, String))
'统计更新日志条目
#If BETA Then
If LastVersion < 321 Then 'Release 2.7.1
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复启动部分整合包导致设置丢失的 Bug"))
BugCount += 1
End If
If LastVersion < 319 Then 'Release 2.7.0
FeatureList.Add(New KeyValuePair(Of Integer, String)(5, "支持更新 Mod"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "支持查看可更新的 Mod 的更新日志"))
@@ -96,7 +100,15 @@ Public Class FormMain
'3：BUG+ IMP* FEAT-
'2：BUG* IMP-
'1：BUG-
If LastVersion < 318 Then 'Snapshot 2.7.1
If LastVersion < 322 Then 'Snapshot 2.7.2
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "添加 启动游戏前进行内存优化 设置"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(2, "优化 MC 性能"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复安装 OptiFine 有概率失败的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复启动 Fabric 1.20.5+ 时无法正确选择 Java 的 Bug"))
FeatureCount += 18
BugCount += 18
End If
If LastVersion < 320 Then 'Snapshot 2.7.1
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复启动部分整合包导致设置丢失的 Bug"))
BugCount += 1
End If
@@ -430,6 +442,8 @@ Public Class FormMain
Log("[Start] 最高版本号从 " & LowerVersionCode & " 升高到 " & VersionCode)
End If
#End If
'被移除的窗口设置选项
If Setup.Get("LaunchArgumentWindowType") = 5 Then Setup.Set("LaunchArgumentWindowType", 1)
'修改主题设置项名称
If LowerVersionCode <= 207 Then
Dim UnlockedTheme As New List(Of String) From {"2"}
@@ -653,7 +667,7 @@ Public Class FormMain
If e.ChangedButton = MouseButton.XButton1 OrElse e.ChangedButton = MouseButton.XButton2 Then TriggerPageBack()
End Sub
Private Sub TriggerPageBack()
If PageCurrent = PageType.Download AndAlso PageCurrentSub = PageSubType.DownloadInstall Then
If PageCurrent = PageType.Download AndAlso PageCurrentSub = PageSubType.DownloadInstall AndAlso FrmDownloadInstall.IsInSelectPage Then
FrmDownloadInstall.ExitSelectPage()
Else
PageBack()
@@ -761,7 +775,7 @@ Public Class FormMain
RunInNewThread(
Sub()
Dim FilePath As String = FilePathList.First
Log("[System] 接受文件拖拽：" & FilePath & If(FilePathList.Count > 0, $" 等 {FilePathList.Count} 个文件", ""), LogLevel.Developer)
Log("[System] 接受文件拖拽：" & FilePath & If(FilePathList.Any, $" 等 {FilePathList.Count} 个文件", ""), LogLevel.Developer)
'基础检查
If Directory.Exists(FilePathList.First) AndAlso Not File.Exists(FilePathList.First) Then
Hint("请拖入一个文件，而非文件夹！", HintType.Critical)
@@ -1176,8 +1190,11 @@ Install:
''' 通过点击返回按钮或手动触发返回来改变页面。
''' </summary>
Public Sub PageBack() Handles BtnTitleInner.Click
If Not PageStack.Any() Then Exit Sub
PageChangeActual(PageStack(0))
If PageStack.Any() Then
PageChangeActual(PageStack(0))
Else
PageChange(PageType.Launch)
End If
End Sub
'实际处理页面切换
@@ -1357,23 +1374,22 @@ Install:
End Sub
Private Sub PanMainLeft_Resize(NewWidth As Double)
Dim Delta As Double = NewWidth - RectLeftBackground.Width
If Math.Abs(Delta) < 0.1 Then Exit Sub
If AniControlEnabled = 0 Then
If Math.Abs(Delta) > 0.1 AndAlso AniControlEnabled = 0 Then
If PanMain.Opacity < 0.1 Then PanMainLeft.IsHitTestVisible = False '避免左边栏指向背景未能完美覆盖左边栏
If NewWidth > 0 Then
'宽度足够，显示
AniStart({
AaWidth(RectLeftBackground, NewWidth - RectLeftBackground.Width, 400,, New AniEaseOutFluent(AniEasePower.ExtraStrong)),
AaOpacity(RectLeftShadow, 1 - RectLeftShadow.Opacity, 200),
AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 250)
}, "FrmMain LeftChange", True)
AaWidth(RectLeftBackground, NewWidth - RectLeftBackground.Width, 400,, New AniEaseOutFluent(AniEasePower.ExtraStrong)),
AaOpacity(RectLeftShadow, 1 - RectLeftShadow.Opacity, 200),
AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 250)
}, "FrmMain LeftChange", True)
Else
'宽度不足，隐藏
AniStart({
AaWidth(RectLeftBackground, -RectLeftBackground.Width, 200,, New AniEaseOutFluent),
AaOpacity(RectLeftShadow, -RectLeftShadow.Opacity, 200),
AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 170)
}, "FrmMain LeftChange", True)
AaWidth(RectLeftBackground, -RectLeftBackground.Width, 200,, New AniEaseOutFluent),
AaOpacity(RectLeftShadow, -RectLeftShadow.Opacity, 200),
AaCode(Sub() PanMainLeft.IsHitTestVisible = True, 170)
}, "FrmMain LeftChange", True)
End If
Else
RectLeftBackground.Width = NewWidth
Plain Craft Launcher 2/Modules/Base/ModBase.vb
+47 -45
View File
@@ -11,12 +11,12 @@ Public Module ModBase
#Region "声明"
'下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.7.1" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.7.1." & VersionBranchCode '标准格式的四段式版本号
Public Const VersionBaseName As String = "2.7.2" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.7.2." & VersionBranchCode '标准格式的四段式版本号
#If BETA Then
Public Const VersionCode As Integer = 319 'Release
Public Const VersionCode As Integer = 321 'Release
#Else
Public Const VersionCode As Integer = 320 'Snapshot
Public Const VersionCode As Integer = 322 'Snapshot
#End If
'自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -58,7 +58,7 @@ Public Module ModBase
''' <summary>
''' 程序的打开计时。
''' </summary>
Public ApplicationStartTick As Long
Public ApplicationStartTick As Long = GetTimeTick()
''' <summary>
''' 程序打开时的时间。
''' </summary>
@@ -76,6 +76,10 @@ Public Module ModBase
''' </summary>
Public Is32BitSystem As Boolean = Not Environment.Is64BitOperatingSystem
''' <summary>
''' 是否使用 GBK 编码。
''' </summary>
Public IsGBKEncoding As Boolean = Encoding.Default.CodePage = 936
''' <summary>
''' 操作系统版本。Win10 为 10.0。
''' </summary>
Public OsVersion As Version = Environment.OSVersion.Version
@@ -726,8 +730,8 @@ Public Module ModBase
Public Function GetFileNameFromPath(FilePath As String) As String
FilePath = FilePath.Replace("/", "\")
If FilePath.EndsWithF("\") Then Throw New Exception("不包含文件名：" & FilePath)
If FilePath.Contains("\") Then FilePath = FilePath.Substring(FilePath.LastIndexOfF("\") + 1)
If FilePath.Contains("?") Then FilePath = FilePath.Substring(0, FilePath.IndexOfF("?")) '去掉网络参数后的 ?
If FilePath.Contains("\") Then FilePath = FilePath.Substring(FilePath.LastIndexOfF("\") + 1)
Dim length As Integer = FilePath.Length
If length = 0 Then Throw New Exception("不包含文件名：" & FilePath)
If length > 250 Then Throw New PathTooLongException("文件名过长：" & FilePath)
@@ -1215,43 +1219,35 @@ Re:
''' <summary>
''' 尝试根据后缀名判断文件种类并解压文件，支持 gz 与 zip，会尝试将 jar 以 zip 方式解压。
''' 会尝试创建，但不会清空目标文件夹。
''' 成功返回 True，并非压缩文件或失败返回 False。
''' </summary>
Public Function ExtractFile(CompressFilePath As String, DestDirectory As String, Optional Encode As Encoding = Nothing) As Boolean
Try
Directory.CreateDirectory(DestDirectory)
If CompressFilePath.EndsWithF(".gz", True) Then
'以 gz 方式解压
Dim stream As New GZipStream(New FileStream(CompressFilePath, FileMode.Open, FileAccess.ReadWrite), CompressionMode.Decompress)
Dim decompressedFile As New FileStream(DestDirectory & GetFileNameFromPath(CompressFilePath).ToLower.Replace(".tar", "").Replace(".gz", ""), FileMode.OpenOrCreate, FileAccess.Write)
Dim data As Integer = stream.ReadByte()
While data <> -1
decompressedFile.WriteByte(data)
data = stream.ReadByte()
End While
decompressedFile.Close()
stream.Close()
Return True
Else
'以 zip 方式解压
Using Archive = ZipFile.Open(CompressFilePath, ZipArchiveMode.Read, If(Encode, Encoding.GetEncoding("GB18030")))
For Each Entry As ZipArchiveEntry In Archive.Entries
Dim DestinationPath As String = IO.Path.Combine(DestDirectory, Entry.FullName)
If DestinationPath.EndsWithF("\") OrElse DestinationPath.EndsWithF("/") Then
Continue For '不创建空文件夹
Else
Directory.CreateDirectory(GetPathFromFullPath(DestinationPath))
Entry.ExtractToFile(DestinationPath, True)
End If
Next
End Using
Return True
End If
Catch ex As Exception
Log(ex, "尝试解压文件失败")
Return False
End Try
End Function
Public Sub ExtractFile(CompressFilePath As String, DestDirectory As String, Optional Encode As Encoding = Nothing)
Directory.CreateDirectory(DestDirectory)
If CompressFilePath.EndsWithF(".gz", True) Then
'以 gz 方式解压
Dim stream As New GZipStream(New FileStream(CompressFilePath, FileMode.Open, FileAccess.ReadWrite), CompressionMode.Decompress)
Dim decompressedFile As New FileStream(DestDirectory & GetFileNameFromPath(CompressFilePath).ToLower.Replace(".tar", "").Replace(".gz", ""), FileMode.OpenOrCreate, FileAccess.Write)
Dim data As Integer = stream.ReadByte()
While data <> -1
decompressedFile.WriteByte(data)
data = stream.ReadByte()
End While
decompressedFile.Close()
stream.Close()
Else
'以 zip 方式解压
Using Archive = ZipFile.Open(CompressFilePath, ZipArchiveMode.Read, If(Encode, Encoding.GetEncoding("GB18030")))
For Each Entry As ZipArchiveEntry In Archive.Entries
Dim DestinationPath As String = IO.Path.Combine(DestDirectory, Entry.FullName)
If DestinationPath.EndsWithF("\") OrElse DestinationPath.EndsWithF("/") Then
Continue For '不创建空文件夹
Else
Directory.CreateDirectory(GetPathFromFullPath(DestinationPath))
Entry.ExtractToFile(DestinationPath, True)
End If
Next
End Using
End If
End Sub
''' <summary>
''' 删除文件夹，返回删除的文件个数。通过参数选择是否抛出异常。
@@ -1342,7 +1338,7 @@ Re:
Loop
DescList = DescList.Distinct.ToList
Dim Desc As String = Join(DescList, vbCrLf & "→ ")
Dim Stack As String = If(StackList.Count > 0, vbCrLf & Join(StackList, vbCrLf), "")
Dim Stack As String = If(StackList.Any, vbCrLf & Join(StackList, vbCrLf), "")
'常见错误（记得同时修改下面的）
Dim CommonReason As String = Nothing
@@ -1541,6 +1537,12 @@ Re:
Next
Return tmp.ToString()
End Function
''' <summary>
''' 检查字符串中的字符是否均为 ASCII 字符。
''' </summary>
<Extension> Public Function IsASCII(Input As String) As Boolean
Return Input.All(Function(c) AscW(c) < 128)
End Function
''' <summary>
''' 高速的 StartsWith。
@@ -2073,7 +2075,7 @@ NextElement:
''' <param name="SortRule">传入两个对象，若第一个对象应该排在前面，则返回 True。</param>
Public Function Sort(Of T)(List As IList(Of T), SortRule As CompareThreadStart(Of T)) As List(Of T)
Dim NewList As New List(Of T)
While List.Count > 0
While List.Any
Dim Highest = List(0)
For i = 1 To List.Count - 1
If SortRule(List(i), Highest) Then Highest = List(i)
@@ -2646,7 +2648,7 @@ Retry:
''' </summary>
Public Function Shuffle(Of T)(array As IList(Of T)) As IList(Of T)
Shuffle = New List(Of T)
Do While array.Count > 0
Do While array.Any
Dim i As Integer = RandomInteger(0, array.Count - 1)
Shuffle.Add(array(i))
array.RemoveAt(i)
Plain Craft Launcher 2/Modules/Base/ModLoader.vb
+3 -4
View File
@@ -571,7 +571,7 @@ Restart:
Public LoaderTaskbarProgress As Double = 0 '平滑后的进度
Private LoaderTaskbarProgressLast As Shell.TaskbarItemProgressState = Shell.TaskbarItemProgressState.None
Public Sub LoaderTaskbarAdd(Loader As LoaderBase)
Public Sub LoaderTaskbarAdd(Of T)(Loader As LoaderCombo(Of T))
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRemove(Loader)
SyncLock LoaderTaskbarLock
LoaderTaskbar.Add(Loader)
@@ -587,11 +587,11 @@ Restart:
'外显任务是否已经全部完成
Dim IsAllDownloadTaskCompleted As Boolean = True
For Each Loader In LoaderTaskbar
If Loader.Show AndAlso Loader.State = LoadState.Loading Then IsAllDownloadTaskCompleted = False
If Loader.State = LoadState.Loading Then IsAllDownloadTaskCompleted = False
Next
'若单个任务已中止或全部任务已完成，则刷新并移除
For Each Task In LoaderTaskbar.ToList()
If (IsAllDownloadTaskCompleted OrElse Task.State = LoadState.Aborted OrElse Task.State = LoadState.Waiting) AndAlso Task.Show Then
If IsAllDownloadTaskCompleted OrElse Task.State = LoadState.Aborted OrElse Task.State = LoadState.Waiting Then
If FrmSpeedLeft IsNot Nothing Then FrmSpeedLeft.TaskRefresh(Task)
LoaderTaskbar.Remove(Task)
Log($"[Taskbar] {Task.Name} 已移出任务列表")
@@ -628,7 +628,6 @@ Restart:
Dim Total As Double = 0, Count As Integer = 0
SyncLock LoaderTaskbarLock
For Each Task In LoaderTaskbar.ToList
If Not Task.Show Then Continue For
Total += Task.Progress
Count += 1 '避免多线程影响导致计数出错
Next
Plain Craft Launcher 2/Modules/Base/ModNet.vb
+216 -286
View File
@@ -1,4 +1,5 @@
Imports System.Net
Imports PCL.ModNet
Public Module ModNet
Public Const NetDownloadEnd As String = ".PCLDownloading"
@@ -235,11 +236,11 @@ RequestFinished:
''' 以多线程下载网页文件的方式获取网页源代码。
''' </summary>
''' <param name="Urls">网页的 Url 列表。</param>
Public Function NetGetCodeByDownload(Urls As String(), Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False, Optional UseBrowserUserAgent As Boolean = False) As String
Dim Temp As String = PathTemp & "Cache\Code\" & Urls(0).GetHashCode() & "_" & GetUuid()
Public Function NetGetCodeByDownload(Urls As IEnumerable(Of String), Optional Timeout As Integer = 45000, Optional IsJson As Boolean = False, Optional UseBrowserUserAgent As Boolean = False) As String
Dim Temp As String = PathTemp & "Cache\Code\" & Urls.First.GetHashCode() & "_" & GetUuid()
Dim NewTask As New LoaderDownload("源码获取 " & GetUuid() & "#", New List(Of NetFile) From {New NetFile(Urls, Temp, New FileChecker With {.IsJson = IsJson}, UseBrowserUserAgent)})
Try
NewTask.WaitForExitTime(Timeout, TimeoutMessage:="连接服务器超时（第一下载源：" & Urls(0) & "）")
NewTask.WaitForExitTime(Timeout, TimeoutMessage:="连接服务器超时（第一下载源：" & Urls.First & "）")
NetGetCodeByDownload = ReadFile(Temp)
File.Delete(Temp)
Finally
@@ -448,7 +449,7 @@ RequestFinished:
''' <summary>
''' 速度下限。
''' </summary>
Public NetTaskSpeedLimitLow As Long = 1024 * 1024L
Public NetTaskSpeedLimitLow As Long = 256 * 1024L '256K/s
''' <summary>
''' 速度上限。若无限制则为 -1。
''' </summary>
@@ -601,7 +602,7 @@ RequestFinished:
SyncLock Task.LockChain
If NextThread Is Nothing Then
If Task.IsUnknownSize Then
Return 1024 * 1024 * 1024 '1G
Return 5 * 1024 * 1024 * 1024L '5G
Else
Return Task.FileSize - 1
End If
@@ -616,7 +617,7 @@ RequestFinished:
''' </summary>
Public ReadOnly Property DownloadUndone As Long
Get
Return DownloadEnd + 1 - (DownloadStart + DownloadDone)
Return DownloadEnd - (DownloadStart + DownloadDone) + 1
End Get
End Property
''' <summary>
@@ -715,7 +716,7 @@ RequestFinished:
CurrentSource = Sources(Id)
End While
Return CurrentSource
ElseIf SourcesOnce.Count > 0 Then
ElseIf SourcesOnce.Any Then
'仅存在单线程可用源
Return SourcesOnce(0)
Else
@@ -728,7 +729,7 @@ RequestFinished:
''' 是否已经没有可用源了。
''' </summary>
Public Function IsSourceFailed(Optional AllowOnceSource As Boolean = True) As Boolean
If AllowOnceSource AndAlso SourcesOnce.Count > 0 Then Return False
If AllowOnceSource AndAlso SourcesOnce.Any Then Return False
SyncLock LockSource
For Each Source As NetSource In Sources
If Not Source.IsFailed Then Return False
@@ -754,15 +755,12 @@ RequestFinished:
''' 导致下载失败的原因。
''' </summary>
Public Ex As New List(Of Exception)
'''' <summary>
'''' 文件进行整体重试的计数。
'''' </summary>
'Private RetryCount As Integer = 0
''' <summary>
''' 作为文件组成部分的线程链表。
''' 如果没有线程，可以为 Nothing。
''' </summary>
Private Threads As NetThread
Public Threads As NetThread
''' <summary>
''' 文件的总大小。若为 -2 则为未获取，若为 -1 则为无法获取准确大小。
@@ -844,10 +842,10 @@ RequestFinished:
Case NetState.Get
Return 0.04
Case NetState.Download
'正在下载中，对应 5% ~ 99%
'正在下载中，对应 5% ~ 98%
Dim OriginalProgress As Double = If(IsUnknownSize, 0.5, DownloadDone / Math.Max(FileSize, 1))
OriginalProgress = 1 - (1 - OriginalProgress) ^ 0.9
Return OriginalProgress * 0.94 + 0.05
Return OriginalProgress * 0.93 + 0.05
Case NetState.Merge
Return 0.99
Case NetState.Finish, NetState.Error
@@ -878,14 +876,13 @@ RequestFinished:
End Property
Private Const FilePieceLimit As Long = 256 * 1024
Public ReadOnly RandomCode As Integer = RandomInteger(0, 999999)
Public ReadOnly LockCount As New Object
Public ReadOnly LockState As New Object
Public ReadOnly LockChain As New Object
Public ReadOnly LockSource As New Object
Public ReadOnly LockTasks As New Object
Private ReadOnly Uuid As Integer = GetUuid()
Public ReadOnly Uuid As Integer = GetUuid()
Public Overrides Function Equals(obj As Object) As Boolean
Dim file = TryCast(obj, NetFile)
Return file IsNot Nothing AndAlso Uuid = file.Uuid
@@ -914,14 +911,15 @@ RequestFinished:
''' <summary>
''' 尝试开始一个新的下载线程。
''' 如果失败，返回 Nothing。
''' </summary>
Public Function TryBeginThread() As Boolean
Public Function TryBeginThread() As NetThread
Try
'条件检测
If NetTaskThreadCount >= NetTaskThreadLimit OrElse IsSourceFailed() OrElse
(IsNoSplit AndAlso Threads IsNot Nothing AndAlso Threads.State <> NetState.Error) Then Return False
If State >= NetState.Merge OrElse State = NetState.WaitForCheck Then Return False
(IsNoSplit AndAlso Threads IsNot Nothing AndAlso Threads.State <> NetState.Error) Then Return Nothing
If State >= NetState.Merge OrElse State = NetState.WaitForCheck Then Return Nothing
SyncLock LockState
If State < NetState.Connect Then State = NetState.Connect
End SyncLock
@@ -936,7 +934,7 @@ RequestFinished:
'单线程
If IsSourceFailed(False) Then
'确认没有其他线程正使用此点
If SourcesOnce(0).Thread IsNot Nothing AndAlso SourcesOnce(0).Thread.State <> NetState.Error Then Return False
If SourcesOnce(0).Thread IsNot Nothing AndAlso SourcesOnce(0).Thread.State <> NetState.Error Then Return Nothing
'占用此点
Capture:
SmailFileCache = Nothing
@@ -952,14 +950,8 @@ Capture:
If Threads Is Nothing Then
StartPosition = 0
StartSource = GetSource(FirstThreadSource)
If StartSource Is Nothing Then
'没有可用源了
Throw New Exception("无可用源，请反馈此问题。")
Else
'有可用源
FirstThreadSource = StartSource.Id + 1
GoTo StartThread
End If
FirstThreadSource = StartSource.Id + 1
GoTo StartThread
End If
'寻找失败点
For Each Thread As NetThread In Threads
@@ -971,24 +963,25 @@ Capture:
Next
'是否禁用多线程，以及规定碎片大小
Dim TargetUrl As String = GetSource().Url
If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("gitcode.net") OrElse TargetUrl.Contains("github.com") Then Return False
If TargetUrl.Contains("pcl2-server") OrElse TargetUrl.Contains("gitcode.net") OrElse TargetUrl.Contains("github.com") OrElse TargetUrl.Contains("modrinth.com") Then Return Nothing
'寻找最大碎片
'FUTURE: 下载引擎重做，计算下载源平均链接时间和线程下载速度，按最高时间节省来开启多线程
Dim FilePieceMax As NetThread = Threads
For Each Thread As NetThread In Threads
If Thread.DownloadUndone > FilePieceMax.DownloadUndone Then FilePieceMax = Thread
Next
If FilePieceMax Is Nothing OrElse FilePieceMax.DownloadUndone < FilePieceLimit Then Return False
If FilePieceMax Is Nothing OrElse FilePieceMax.DownloadUndone < FilePieceLimit Then Return Nothing
StartPosition = FilePieceMax.DownloadEnd - FilePieceMax.DownloadUndone * 0.4
StartSource = GetSource()
'开始线程
StartThread:
If (StartPosition > FileSize AndAlso FileSize >= 0 AndAlso Not IsUnknownSize) OrElse StartPosition < 0 OrElse IsNothing(StartSource) Then Return False
If (StartPosition > FileSize AndAlso FileSize >= 0 AndAlso Not IsUnknownSize) OrElse StartPosition < 0 OrElse IsNothing(StartSource) Then Return Nothing
'构建线程
Dim ThreadUuid As Integer = GetUuid()
SyncLock LockTasks
If Not Tasks.Any() Then Return False '由于中断，已没有可用任务
Th = New Thread(AddressOf Thread) With {.Name = "NetTask " & Tasks(0).Uuid & "/" & Uuid & " Download " & ThreadUuid & "#", .Priority = ThreadPriority.BelowNormal}
If Not Tasks.Any() Then Return Nothing '由于中断，已没有可用任务
Th = New Thread(AddressOf Thread) With {.Name = $"NetTask {Tasks(0).Uuid}/{Uuid} Download {ThreadUuid}#", .Priority = ThreadPriority.BelowNormal}
End SyncLock
ThreadInfo = New NetThread With {.Uuid = ThreadUuid, .DownloadStart = StartPosition, .Thread = Th, .Source = StartSource, .Task = Me, .State = NetState.WaitForDownload}
'链表处理
@@ -1012,11 +1005,11 @@ StartThread:
If IsSourceFailed(False) Then SourcesOnce(0).Thread = ThreadInfo
End SyncLock
Th.Start(ThreadInfo)
Return True
Return ThreadInfo
Catch ex As Exception
Log(ex, "尝试开始下载线程失败（" & If(LocalName, "Nothing") & "）", LogLevel.Hint)
Return False
Return Nothing
End Try
End Function
''' <summary>
@@ -1040,35 +1033,44 @@ StartThread:
HttpRequest.Timeout = Timeout
HttpRequest.AddRange(Info.DownloadStart)
SecretHeadersSign(Info.Source.Url, HttpRequest, UseBrowserUserAgent)
Dim ContentLength As Long = 0
Using HttpResponse As HttpWebResponse = HttpRequest.GetResponse()
If ModeDebug AndAlso HttpResponse.ResponseUri.OriginalString <> Info.Source.Url Then
Log($"[Download] {LocalName} {Info.Uuid}#：重定向至 {HttpResponse.ResponseUri.OriginalString}")
End If
'文件大小校验
Dim ThreadFileSize = HttpResponse.ContentLength
If ThreadFileSize = -1 Then
ContentLength = HttpResponse.ContentLength
If ContentLength = -1 Then
If FileSize > 1 Then
Log("[Download] " & LocalName & " " & Info.Uuid & "#：文件大小未知，但已从其他下载源获取，不作处理")
If Info.DownloadStart = 0 Then
Log($"[Download] {LocalName} {Info.Uuid}#：文件大小未知，但已从其他下载源获取，不作处理")
Else
Log($"[Download] {LocalName} {Info.Uuid}#：ContentLength 返回了 -1，无法确定是否支持分段下载，视作不支持")
GoTo NotSupportRange
End If
Else
FileSize = -1 : IsUnknownSize = True
Log("[Download] " & LocalName & " " & Info.Uuid & "#：文件大小未知")
Log($"[Download] {LocalName} {Info.Uuid}#：文件大小未知")
End If
ElseIf ThreadFileSize < 0 Then
Throw New Exception("获取片大小失败，结果为 " & ThreadFileSize & "。")
ElseIf ContentLength < 0 Then
Throw New Exception("获取片大小失败，结果为 " & ContentLength & "。")
ElseIf Info.IsFirstThread Then
If Check IsNot Nothing Then
If ThreadFileSize < Check.MinSize AndAlso Check.MinSize > 0 Then
Throw New Exception("文件大小不足，获取结果为 " & ThreadFileSize & "，要求至少为 " & Check.MinSize & "。")
If ContentLength < Check.MinSize AndAlso Check.MinSize > 0 Then
Throw New Exception($"文件大小不足，获取结果为 {ContentLength}，要求至少为 {Check.MinSize}。")
End If
If ThreadFileSize <> Check.ActualSize AndAlso Check.ActualSize > 0 Then
Throw New Exception("文件大小不一致，获取结果为 " & ThreadFileSize & "，要求必须为 " & Check.ActualSize & "。")
If ContentLength <> Check.ActualSize AndAlso Check.ActualSize > 0 Then
Throw New Exception($"文件大小不一致，获取结果为 {ContentLength}，要求必须为 {Check.ActualSize}。")
End If
End If
FileSize = ThreadFileSize : IsUnknownSize = False
Log("[Download] " & LocalName & "：文件大小 " & ThreadFileSize & " B" & "（" & GetString(ThreadFileSize) & "）")
FileSize = ContentLength : IsUnknownSize = False
Log($"[Download] {LocalName} {Info.Uuid}#：文件大小 {ContentLength}（{GetString(ContentLength)}）")
'若文件大小大于 50 M，进行剩余磁盘空间校验
If ThreadFileSize > 50 * 1024 * 1024 Then
If ContentLength > 50 * 1024 * 1024 Then
For Each Drive As DriveInfo In DriveInfo.GetDrives
Dim DriveName As String = Drive.Name.First.ToString
Dim RequiredSpace = If(PathTemp.StartsWithF(DriveName), ThreadFileSize * 1.1, 0) +
If(LocalPath.StartsWithF(DriveName), ThreadFileSize + 5 * 1024 * 1024, 0)
Dim RequiredSpace = If(PathTemp.StartsWithF(DriveName), ContentLength * 1.1, 0) +
If(LocalPath.StartsWithF(DriveName), ContentLength + 5 * 1024 * 1024, 0)
If Drive.TotalFreeSpace < RequiredSpace Then
Throw New Exception(DriveName & " 盘空间不足，无法进行下载。" & vbCrLf & "需要至少 " & GetString(RequiredSpace) & " 空间，但当前仅剩余 " & GetString(Drive.TotalFreeSpace) & "。" &
If(PathTemp.StartsWithF(DriveName), vbCrLf & vbCrLf & "下载时需要与文件同等大小的空间存放缓存，你可以在设置中调整缓存文件夹的位置。", ""))
@@ -1076,8 +1078,9 @@ StartThread:
Next
End If
ElseIf FileSize < 0 Then
Throw New Exception("非首线程运行时，尚未获取文件大小。")
ElseIf Info.DownloadStart > 0 AndAlso ThreadFileSize = FileSize Then
Throw New Exception("非首线程运行时，尚未获取文件大小")
ElseIf Info.DownloadStart > 0 AndAlso ContentLength = FileSize Then
NotSupportRange:
SyncLock LockSource
If SourcesOnce.Contains(Info.Source) Then
GoTo SourceBreak
@@ -1085,10 +1088,11 @@ StartThread:
SourcesOnce.Add(Info.Source)
End If
End SyncLock
Throw New WebException("该下载源不支持断点续传。")
ElseIf Not FileSize - Info.DownloadStart = ThreadFileSize Then
Throw New WebException("获取到的片大小不一致：线程结果为 " & ThreadFileSize & " B，任务结果为 " & FileSize & "B，起点为 " & Info.DownloadStart & "B。")
Throw New WebException($"该下载源不支持分段下载：Range 起始于 {Info.DownloadStart}，预期 ContentLength 为 {FileSize - Info.DownloadStart}，返回 ContentLength 为 {ContentLength}，总文件大小 {FileSize}")
ElseIf Not FileSize - Info.DownloadStart = ContentLength Then
Throw New WebException($"获取到的分段大小不一致：Range 起始于 {Info.DownloadStart}，预期 ContentLength 为 {FileSize - Info.DownloadStart}，返回 ContentLength 为 {ContentLength}，总文件大小 {FileSize}")
End If
'Log($"[Download] {LocalName} {Info.Uuid}#：通过大小检查，文件大小 {FileSize}，起始点 {Info.DownloadStart}，ContentLength {ContentLength}")
Info.State = NetState.Get
SyncLock LockState
If State < NetState.Get Then State = NetState.Get
@@ -1108,7 +1112,7 @@ StartThread:
Dim HttpData As Byte() = New Byte(16384) {}
HttpDataCount = HttpStream.Read(HttpData, 0, 16384)
While (IsUnknownSize OrElse Info.DownloadUndone > 0) AndAlso '判断是否下载完成
HttpDataCount > 0 AndAlso Not IsProgramEnded AndAlso State < NetState.Merge AndAlso (Not Info.Source.IsFailed OrElse Info.Equals(Info.Source.Thread))
HttpDataCount > 0 AndAlso Not IsProgramEnded AndAlso State < NetState.Merge AndAlso (Not Info.Source.IsFailed OrElse Info.Equals(Info.Source.Thread))
'限速
While NetTaskSpeedLimitHigh > 0 AndAlso NetTaskSpeedLimitLeft <= 0
Threading.Thread.Sleep(16)
@@ -1170,17 +1174,17 @@ StartThread:
End Using
End Using
SourceBreak:
If HttpDataCount = 0 AndAlso Info.DownloadUndone > 0 AndAlso Not IsUnknownSize Then
'服务器无返回数据
Throw New Exception("服务器无返回数据，但下载尚未完成")
ElseIf State = NetState.Error OrElse Info.Source.IsFailed OrElse (Info.DownloadUndone > 0 AndAlso Not IsUnknownSize) Then
If State = NetState.Error OrElse Info.Source.IsFailed OrElse (Info.DownloadUndone > 0 AndAlso Not IsUnknownSize) Then
'被外部中断
Info.State = NetState.Error
Log("[Download] " & LocalName & " " & Info.Uuid & "#：中断")
Log($"[Download] {LocalName} {Info.Uuid}#：中断")
ElseIf HttpDataCount = 0 AndAlso Info.DownloadUndone > 0 AndAlso Not IsUnknownSize Then
'服务器无返回数据
Throw New Exception($"返回的 ContentLength 过多：ContentLength 为 {ContentLength}，但获取到的总数据量仅为 {Info.DownloadDone}（全文件总数据量 {DownloadDone}）")
Else
'本线程完成
Info.State = NetState.Finish
If ModeDebug Then Log("[Download] " & LocalName & " " & Info.Uuid & "#：完成，已下载 " & GetString(Info.DownloadDone))
If ModeDebug Then Log($"[Download] {LocalName} {Info.Uuid}#：完成，已下载 {Info.DownloadDone}")
End If
Catch ex As Exception
'状态变更
@@ -1212,11 +1216,11 @@ SourceBreak:
'End SyncLock
Info.Source.Ex = ex
'根据情况判断，是否在多线程下禁用下载源（连续错误过多，或不支持断点续传）
'BMCLAPI 的部分源在高频率请求下会返回 403，所以不应因此禁用下载源
If ex.Message.Contains("该下载源不支持") OrElse ex.Message.Contains("未能解析") OrElse ex.Message.Contains("(404)") OrElse
ex.Message.Contains("(502)") OrElse ex.Message.Contains("无返回数据") OrElse ex.Message.Contains("空间不足") OrElse ex.Message.Contains("获取到的片大小不一致") OrElse
(Info.Source.FailCount >= MathClamp(NetTaskThreadLimit, 5, 40) AndAlso DownloadDone < 1) OrElse
Info.Source.FailCount > NetTaskThreadLimit Then
ex.Message.Contains("(502)") OrElse ex.Message.Contains("无返回数据") OrElse ex.Message.Contains("空间不足") OrElse ex.Message.Contains("获取到的分段大小不一致") OrElse
(ex.Message.Contains("(403)") AndAlso Not Info.Source.Url.ContainsF("bmclapi")) OrElse 'BMCLAPI 的部分源在高频率请求下会返回 403，所以不应因此禁用下载源
(Info.Source.FailCount >= MathClamp(NetTaskThreadLimit, 5, 30) AndAlso DownloadDone < 1) OrElse
Info.Source.FailCount > NetTaskThreadLimit + 2 Then
Dim IsThisFail As Boolean = False
SyncLock LockSource
If Info.Source.Thread IsNot Nothing AndAlso Info.Source.Thread.Equals(Info) Then
@@ -1232,8 +1236,8 @@ Wrong:
End SyncLock
'本线程引发下载源被禁用
If IsThisFail Then
Log("[Download] " & LocalName & " " & Uuid & "#：下载源被禁用（" & Info.Source.Id & "）：" & Info.Source.Url)
Log(ex, "下载源 " & Info.Source.Id & " 已被禁用", If(ex.Message.Contains("不支持断点续传") OrElse ex.Message.Contains("(404)") OrElse ex.Message.Contains("(416)"), LogLevel.Developer, LogLevel.Debug))
Log($"[Download] {LocalName} {Info.Uuid}#：下载源被禁用（{Info.Source.Id}）：{Info.Source.Url}")
Log(ex, "下载源 " & Info.Source.Id & " 已被禁用", If(ex.Message.Contains("不支持分段下载") OrElse ex.Message.Contains("(404)") OrElse ex.Message.Contains("(416)"), LogLevel.Developer, LogLevel.Debug))
If IsSourceFailed() Then
'没有可用源
Log("[Download] 文件 " & LocalName & " 已无可用下载源")
@@ -1265,6 +1269,7 @@ Wrong:
SyncLock NetTaskThreadCountLock
NetTaskThreadCount -= 1
End SyncLock
'可能在没有下载完的时候开始合并文件了，这造成了大多数合并失败
If ((FileSize >= 0 AndAlso DownloadDone >= FileSize) OrElse (FileSize = -1 AndAlso DownloadDone > 0)) AndAlso State < NetState.Merge Then Merge()
End Try
End Sub
@@ -1287,7 +1292,6 @@ Wrong:
Try
Retry:
SyncLock LockChain
If ModeDebug Then Log("[Download] " & LocalName & "：正在合并文件")
'创建文件夹
If File.Exists(LocalPath) Then File.Delete(LocalPath)
Dim Info As New FileInfo(LocalPath)
@@ -1295,6 +1299,7 @@ Retry:
'合并文件
If IsNoSplit Then
'仅有一个线程，从缓存中输出
If ModeDebug Then Log($"[Download] {LocalName}：下载结束，从缓存输出文件")
MergeFile = New FileStream(LocalPath, FileMode.Create)
AddWriter = New BinaryWriter(MergeFile)
AddWriter.Write(SmailFileCache.ToArray)
@@ -1302,17 +1307,19 @@ Retry:
MergeFile.Dispose() : MergeFile = Nothing
ElseIf Threads.DownloadDone = DownloadDone AndAlso Threads.Temp IsNot Nothing Then
'仅有一个文件，直接复制
If ModeDebug Then Log($"[Download] {LocalName}：下载结束，仅有一个文件，无需合并")
CopyFile(Threads.Temp, LocalPath)
Else
'有多个线程，合并
If ModeDebug Then Log($"[Download] {LocalName}：下载结束，开始合并文件")
MergeFile = New FileStream(LocalPath, FileMode.Create)
AddWriter = New BinaryWriter(MergeFile)
For Each Thread As NetThread In Threads
If Thread.DownloadDone = 0 OrElse Thread.Temp Is Nothing Then Continue For
Using fs As New FileStream(Thread.Temp, FileMode.Open, FileAccess.Read, FileShare.Read)
Dim TempReader As New BinaryReader(fs)
AddWriter.Write(TempReader.ReadBytes(fs.Length))
TempReader.Close()
Using TempReader As New BinaryReader(fs)
AddWriter.Write(TempReader.ReadBytes(Thread.DownloadDone))
End Using
End Using
Next
AddWriter.Dispose() : AddWriter = Nothing
@@ -1329,9 +1336,9 @@ Retry:
'检查文件
Dim CheckResult As String = Check?.Check(LocalPath)
If CheckResult IsNot Nothing Then
Log("[Download] " & Uuid & "# 的下载线程细节：")
Log($"[Download] {LocalName} 合并文件失败，下载线程细节：")
For Each Th As NetThread In Threads
Log("[Download] " & Th.Uuid & "#，状态 " & GetStringFromEnum(CType(Th.State, [Enum])) & "，字节范围 " & Th.DownloadStart & "~" & (Th.DownloadStart + Th.DownloadDone) & "，字节剩余 " & Th.DownloadUndone)
Log($"[Download] {Th.Uuid}#，状态 {GetStringFromEnum(Th.State)}，范围 {Th.DownloadStart}~{Th.DownloadStart + Th.DownloadDone}，完成 {Th.DownloadDone}，剩余 {Th.DownloadUndone}")
Next
Throw New Exception(CheckResult)
End If
@@ -1379,11 +1386,6 @@ Retry:
SyncLock NetManager.LockRemain
NetManager.FileRemain -= 1
Log("[Download] " & LocalName & "：已失败，剩余文件 " & NetManager.FileRemain)
'If NetManage.FileRemainList.Contains(LocalPath) Then
' NetManage.FileRemainList.Remove(LocalPath)
'Else
' Log("ERROR " & LocalPath)
'End If
End SyncLock
For Each Task In Tasks
Task.OnFileFail(Me)
@@ -1396,7 +1398,7 @@ Retry:
'确认任务移除
SyncLock LockTasks
Tasks.Remove(CausedByTask)
If Tasks.Count > 0 Then Exit Sub
If Tasks.Any Then Exit Sub
End SyncLock
'确认中断
SyncLock LockState
@@ -1406,11 +1408,6 @@ Retry:
SyncLock NetManager.LockRemain
NetManager.FileRemain -= 1
If ModeDebug Then Log("[Download] " & LocalName & "：已取消，剩余文件 " & NetManager.FileRemain)
'If NetManage.FileRemainList.Contains(LocalPath) Then
' NetManage.FileRemainList.Remove(LocalPath)
'Else
' Log("ERROR " & LocalPath)
'End If
End SyncLock
End Sub
@@ -1426,11 +1423,6 @@ Retry:
SyncLock NetManager.LockRemain
NetManager.FileRemain -= 1
If PrintLog Then Log("[Download] " & LocalName & "：已完成，剩余文件 " & NetManager.FileRemain)
'If NetManage.FileRemainList.Contains(LocalPath) Then
' NetManage.FileRemainList.Remove(LocalPath)
'Else
' Log("ERROR " & LocalPath)
'End If
End SyncLock
SyncLock LockTasks
For Each Task In Tasks
@@ -1507,7 +1499,7 @@ FinishExCatch:
#End Region
''' <summary>
''' 刷新公开属性。由 NetManager 每 0.2 秒调用一次。
''' 刷新公开属性。由 NetManager 每 0.1 秒调用一次。
''' </summary>
Public Sub RefreshStat()
'计算进度
@@ -1519,15 +1511,15 @@ FinishExCatch:
NewProgress += File.Progress * 0.2
TotalProgress += 0.2
Else
NewProgress += File.Progress '* If(File.Progress < 1, 0.9, 1)
NewProgress += File.Progress
TotalProgress += 1
End If
Next
End SyncLock
If TotalProgress > 0 Then NewProgress /= TotalProgress
'刷新进度
If NewProgress < 1 AndAlso NewProgress > 0 Then NewProgress = 1 - (1 - NewProgress) ^ 0.9 'MathBezier(NewProgress, 0, 0.05, 1, 0.8, 0.0001)
_Progress = NewProgress * 0.99 + 0.01
If NewProgress < 1 AndAlso NewProgress > 0 Then NewProgress = 2 * (NewProgress ^ 3) - 3 * (NewProgress ^ 2) + 2 * NewProgress '2x^3-3x^2+2x，模拟开头和结尾更慢的情况
_Progress = NewProgress
End Sub
Public Sub New(Name As String, FileTasks As List(Of NetFile))
@@ -1556,71 +1548,72 @@ NextElement:
End SyncLock
State = LoadState.Loading
'开始执行
RunInNewThread(Sub()
Try
'输入检测
If Not Files.Any() Then
OnFinish()
Exit Sub
End If
For Each File As NetFile In Files
If File Is Nothing Then Throw New ArgumentException("存在空文件请求！")
For Each Source As NetSource In File.Sources
If Not (Source.Url.StartsWithF("https://", True) OrElse Source.Url.StartsWithF("http://", True)) Then
Source.Ex = New ArgumentException("输入的下载链接不正确！")
Source.IsFailed = True
End If
Next
If File.IsSourceFailed() Then Throw New ArgumentException("输入的下载链接不正确！")
If Not File.LocalPath.ToLower.Contains(":\") Then Throw New ArgumentException("输入的本地文件地址不正确！")
If File.LocalPath.EndsWithF("\") Then Throw New ArgumentException("请输入含文件名的完整文件路径！")
'文件夹检测
Dim DirPath As String = New FileInfo(File.LocalPath).Directory.FullName
If Not Directory.Exists(DirPath) Then Directory.CreateDirectory(DirPath)
Next
'接入下载管理器
NetManager.Start(Me)
'将文件分配给多个线程以进行已存在查找
Dim Folders As New List(Of String) '可能会用于已存在查找的文件夹列表
Dim FoldersFinal As New List(Of String) '最终用于查找的列表
If Not Setup.Get("SystemDebugSkipCopy") Then '在设置中禁用复制
Folders.Add(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\") '总是添加官启文件夹，因为 HMCL 会把所有文件存在这里
For Each Folder In McFolderList
Folders.Add(Folder.Path)
Next
Folders = Folders.Distinct.ToList
For Each Folder In Folders
If Folder <> PathMcFolder AndAlso Directory.Exists(Folder) Then FoldersFinal.Add(Folder)
Next
End If
'最多 5 个线程，最少每个线程分配 10 个文件
SyncLock FilesLock
Dim FilesPerThread As Integer = Math.Max(5, Files.Count / 10 + 1)
Dim FilesInThread As New List(Of NetFile)
For Each File In Files
FilesInThread.Add(File)
If FilesInThread.Count = FilesPerThread Then
Dim FilesToRun As New List(Of NetFile)
FilesToRun.AddRange(FilesInThread)
RunInNewThread(Sub() StartCopy(FilesToRun, FoldersFinal), "NetTask FileCopy " & Uuid)
FilesInThread.Clear()
End If
Next
If FilesInThread.Count > 0 Then
Dim FilesToRun As New List(Of NetFile)
FilesToRun.AddRange(FilesInThread)
RunInNewThread(Sub() StartCopy(FilesToRun, FoldersFinal), "NetTask FileCopy " & Uuid)
FilesInThread.Clear()
End If
End SyncLock
Catch ex As Exception
OnFail(New List(Of Exception) From {ex})
End Try
End Sub, "NetTask " & Uuid & " Main")
RunInNewThread(
Sub()
Try
'输入检测
If Not Files.Any() Then
OnFinish()
Exit Sub
End If
For Each File As NetFile In Files
If File Is Nothing Then Throw New ArgumentException("存在空文件请求！")
For Each Source As NetSource In File.Sources
If Not (Source.Url.StartsWithF("https://", True) OrElse Source.Url.StartsWithF("http://", True)) Then
Source.Ex = New ArgumentException("输入的下载链接不正确！")
Source.IsFailed = True
End If
Next
If File.IsSourceFailed() Then Throw New ArgumentException("输入的下载链接不正确！")
If Not File.LocalPath.ToLower.Contains(":\") Then Throw New ArgumentException("输入的本地文件地址不正确！")
If File.LocalPath.EndsWithF("\") Then Throw New ArgumentException("请输入含文件名的完整文件路径！")
'文件夹检测
Dim DirPath As String = New FileInfo(File.LocalPath).Directory.FullName
If Not Directory.Exists(DirPath) Then Directory.CreateDirectory(DirPath)
Next
'接入下载管理器
NetManager.Start(Me)
'将文件分配给多个线程以进行已存在查找
Dim Folders As New List(Of String) '可能会用于已存在查找的文件夹列表
Dim FoldersFinal As New List(Of String) '最终用于查找的列表
If Not Setup.Get("SystemDebugSkipCopy") Then '在设置中禁用复制
Folders.Add(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\") '总是添加官启文件夹，因为 HMCL 会把所有文件存在这里
For Each Folder In McFolderList
Folders.Add(Folder.Path)
Next
Folders = Folders.Distinct.ToList
For Each Folder In Folders
If Folder <> PathMcFolder AndAlso Directory.Exists(Folder) Then FoldersFinal.Add(Folder)
Next
End If
'最多 5 个线程，最少每个线程分配 10 个文件
SyncLock FilesLock
Dim FilesPerThread As Integer = Math.Max(5, Files.Count / 10 + 1)
Dim FilesInThread As New List(Of NetFile)
For Each File In Files
FilesInThread.Add(File)
If FilesInThread.Count = FilesPerThread Then
Dim FilesToRun As New List(Of NetFile)
FilesToRun.AddRange(FilesInThread)
RunInNewThread(Sub() StartCopy(FilesToRun, FoldersFinal), "NetTask FileCopy " & Uuid)
FilesInThread.Clear()
End If
Next
If FilesInThread.Any Then
Dim FilesToRun As New List(Of NetFile)
FilesToRun.AddRange(FilesInThread)
RunInNewThread(Sub() StartCopy(FilesToRun, FoldersFinal), "NetTask FileCopy " & Uuid)
FilesInThread.Clear()
End If
End SyncLock
Catch ex As Exception
OnFail(New List(Of Exception) From {ex})
End Try
End Sub, "NetTask " & Uuid & " Main")
End Sub
Private Sub StartCopy(Files As List(Of NetFile), FolderList As List(Of String))
Try
If ModeDebug Then Log("[Download] 检查线程分配文件数：" & Files.Count)
If ModeDebug Then Log("[Download] 检查线程分配文件数：" & Files.Count & "，线程名：" & Thread.CurrentThread.Name)
'试图从已存在的 Minecraft 文件夹中寻找目标文件
Dim ExistFiles As New List(Of KeyValuePair(Of NetFile, String)) '{NetFile, Target As String}
For Each File As NetFile In Files
@@ -1702,14 +1695,13 @@ Retry:
If ExList Is Nothing OrElse Not ExList.Any() Then ExList = New List(Of Exception) From {New Exception("未知错误！")}
'寻找第一个不是 404 的下载源
Dim UsefulExs = ExList.Where(Function(e) Not e.Message.Contains("(404)")).ToList
[Error] = If(UsefulExs.Count > 0, UsefulExs(0), ExList(0))
[Error] = If(UsefulExs.Any, UsefulExs(0), ExList(0))
'获取实际失败的文件
SyncLock FilesLock
For Each File In Files
If File.State = NetState.Error Then
[Error] = New Exception("文件下载失败：" & File.LocalPath & vbCrLf & Join(
File.Sources.Select(Function(s) If(s.Ex Is Nothing, s.Url, s.Ex.Message & "（" & s.Url & "）")).ToList(),
vbCrLf), [Error])
File.Sources.Select(Function(s) If(s.Ex Is Nothing, s.Url, s.Ex.Message & "（" & s.Url & "）")), vbCrLf), [Error])
Exit For
End If
Next
@@ -1794,9 +1786,9 @@ Retry:
''' </summary>
Private SpeedLastDone As Long = 0
''' <summary>
''' 最近 10 次下载速度的记录，较新的在后面。间隔为 0.2 秒，故记录了 2 秒的速度。
''' 至多最近 30 次下载速度的记录，较新的在前面。
''' </summary>
Public SpeedLast As New List(Of Long) From {0, 0, 0, 0, 0, 0, 0, 0, 0, 0}
Private SpeedLast As New List(Of Long)
'这些属性由 RefreshStat 刷新
''' <summary>
''' 当前的全局下载速度，单位为 Byte / 秒。
@@ -1808,28 +1800,29 @@ Retry:
#End Region
''' <summary>
''' 进度与下载速度由下载管理线程每隔约 0.2 秒刷新一次。
''' 进度与下载速度由下载管理线程每隔约 0.1 秒刷新一次。
''' </summary>
Private Sub RefreshStat()
Try
Dim DeltaTime As Long = GetTimeTick() - RefreshStatLast
RefreshStatLast += DeltaTime
#Region "刷新整体速度"
'计算即时速度
'计算瞬时速度
Dim ActualSpeed As Double = Math.Max(0, (DownloadDone - SpeedLastDone) / (DeltaTime / 1000))
SpeedLast.Add(ActualSpeed)
SpeedLast.RemoveAt(0)
SpeedLast.Insert(0, ActualSpeed)
If SpeedLast.Count >= 31 Then SpeedLast.RemoveAt(30)
SpeedLastDone = DownloadDone
'计算用于显示的速度
'If SpeedLast(9) = 0 Then
' Speed = 0
'Else
Speed = (SpeedLast(9) + SpeedLast(8) * 0.9 + SpeedLast(7) * 0.8 + SpeedLast(6) * 0.7 + SpeedLast(5) * 0.6 + SpeedLast(4) * 0.5 + SpeedLast(3) * 0.4 + SpeedLast(2) * 0.3 + SpeedLast(1) * 0.2 + SpeedLast(0) * 0.1) / 5.5
'End If
Dim SpeedSum As Long = 0, SpeedDiv As Long = 0, Weight = SpeedLast.Count
For Each SpeedRecord In SpeedLast
SpeedSum += SpeedRecord * Weight
SpeedDiv += Weight
Weight -= 1
Next
Speed = If(SpeedDiv > 0, SpeedSum / SpeedDiv, 0)
'计算新的速度下限
SpeedLast.Add(ActualSpeed)
SpeedLast.RemoveAt(0)
Dim Limit As Long = Math.Min(Math.Min(Math.Min(Math.Min(SpeedLast(5), SpeedLast(6)), SpeedLast(7)), SpeedLast(8)), SpeedLast(9)) * 0.9
Dim Limit As Long = 0
If SpeedLast.Count >= 10 Then Limit = SpeedLast.Take(10).Average * 0.85 '取近 1 秒的平均速度的 85%
If Limit > NetTaskSpeedLimitLow Then
NetTaskSpeedLimitLow = Limit
Log("[Download] " & "速度下限已提升到 " & GetString(Limit))
@@ -1854,128 +1847,65 @@ Retry:
Private Sub StartManager()
If IsManagerStarted Then Exit Sub
IsManagerStarted = True
RunInNewThread(
Sub()
Dim ThreadStarter =
Sub(Id As Integer) '0 或 1
Try
Dim LastLoopTime As Long
While True
LastLoopTime = GetTimeTick()
Thread.Sleep(20)
'若已完成，则清空
If FileRemain = 0 AndAlso Files.Count > 0 Then
If Id = 0 AndAlso FileRemain = 0 AndAlso Files.Any() Then
SyncLock LockFiles
Files.Clear()
End SyncLock
End If
'开启新线程
If Speed < NetTaskSpeedLimitLow OrElse FileRemain > NetTaskThreadLimit Then
'速度小于下限或剩余文件还贼多，尝试开启线程
Dim IsSuccess As Boolean = False
Dim NewThreadCount As Integer
'确定最大线程追加数
NewThreadCount = Math.Max(FileRemain, MathClamp(NetTaskThreadCount / 2, 1, 4))
NewThreadCount = Math.Floor(NewThreadCount / 2) '双线程启用减半
NewThreadCount = MathClamp(NewThreadCount, 1, NetTaskThreadLimit)
'循环追加
Do
IsSuccess = False
'启动 Wait 的文件后立即会变成 Connect，导致第二次循环再次调用，所以需要先暂时存储进去……
'此外为了减少 LockFiles 的占用时间，所以先遍历列表再开始
Dim FilesWaiting As New List(Of NetFile)
Dim FilesLoading As New List(Of NetFile)
SyncLock LockFiles
For Each File As NetFile In Files.Values
If File.RandomCode Mod 2 = 0 Then Continue For
If File.State = NetState.WaitForDownload Then
FilesWaiting.Add(File)
ElseIf File.State < NetState.Merge Then
FilesLoading.Add(File)
End If
Next
End SyncLock
'为文件列表中的文件开始线程
For Each File As NetFile In FilesWaiting
If NewThreadCount = 0 Then Exit For
If File.TryBeginThread() Then
IsSuccess = True
NewThreadCount -= 1
'获取文件列表
Dim AllFiles As List(Of NetFile)
SyncLock LockFiles
AllFiles = Files.Values.ToList()
End SyncLock
Dim WaitingFiles As New List(Of NetFile)
Dim OngoingFiles As New List(Of NetFile)
For Each File As NetFile In AllFiles
If File.Uuid Mod 2 = Id Then Continue For
If File.State = NetState.WaitForDownload Then
WaitingFiles.Add(File)
ElseIf File.State < NetState.Merge Then
OngoingFiles.Add(File)
End If
Next
'为等待中的文件开始线程
For Each File As NetFile In WaitingFiles
If NetTaskThreadCount >= NetTaskThreadLimit Then Continue While '最大线程数检查
Dim NewThread = File.TryBeginThread()
If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi.") Then Thread.Sleep(40) '减少 BMCLAPI 请求频率，避免 Too Many Requests
Next
'为进行中的文件追加线程
If Speed >= NetTaskSpeedLimitLow Then Continue While '下载速度足够，无需新增
For Each File As NetFile In OngoingFiles
If NetTaskThreadCount >= NetTaskThreadLimit Then Continue While '最大线程数检查
'线程种类计数
Dim PreparingCount = 0, DownloadingCount = 0
If File.Threads IsNot Nothing Then
For Each Thread As NetThread In File.Threads.ToList
If Thread.State < NetState.Download Then
PreparingCount += 1
ElseIf Thread.State = NetState.Download Then
DownloadingCount += 1
End If
Next
For Each File As NetFile In FilesLoading
If NewThreadCount = 0 Then Exit For
If File.TryBeginThread() Then
IsSuccess = True
NewThreadCount -= 1
End If
Next
'等待 40 ms：BMCLAPI 部分时候有 20QPS 的限制
Thread.Sleep(40)
Loop While NewThreadCount > 0 AndAlso IsSuccess
End If
'等待 40 ms
Thread.Sleep(40)
End If
'新增线程
If PreparingCount > DownloadingCount Then Continue For '准备中的线程已多于下载中的线程，不再新增
Dim NewThread = File.TryBeginThread()
If NewThread IsNot Nothing AndAlso NewThread.Source.Url.Contains("bmclapi.") Then Thread.Sleep(40) '减少 BMCLAPI 请求频率，避免 Too Many Requests
Next
End While
Catch ex As Exception
Log(ex, "下载管理启动线程 1 出错", LogLevel.Assert)
Log(ex, $"下载管理启动线程 {Id} 出错", LogLevel.Assert)
End Try
End Sub, "NetManager ThreadStarter Single")
RunInNewThread(
Sub()
Try
Dim LastLoopTime As Long
While True
LastLoopTime = GetTimeTick()
'开启新线程
If Speed < NetTaskSpeedLimitLow OrElse FileRemain > NetTaskThreadLimit Then
'速度小于下限或剩余文件还贼多，尝试开启线程
Dim IsSuccess As Boolean = False
Dim NewThreadCount As Integer
'确定最大线程追加数
NewThreadCount = Math.Max(FileRemain, MathClamp(NetTaskThreadCount / 2, 1, 4))
NewThreadCount = Math.Floor(NewThreadCount / 2) '双线程启用减半
NewThreadCount = MathClamp(NewThreadCount, 1, NetTaskThreadLimit)
'循环追加
Do
IsSuccess = False
'启动 Wait 的文件后立即会变成 Connect，导致第二次循环再次调用，所以需要先暂时存储进去……
'此外为了减少 LockFiles 的占用时间，所以先遍历列表再开始
Dim FilesWaiting As New List(Of NetFile)
Dim FilesLoading As New List(Of NetFile)
SyncLock LockFiles
For Each File As NetFile In Files.Values
If File.RandomCode Mod 2 = 1 Then Continue For
If File.State = NetState.WaitForDownload Then
FilesWaiting.Add(File)
ElseIf File.State < NetState.Merge Then
FilesLoading.Add(File)
End If
Next
End SyncLock
'为文件列表中的文件开始线程
For Each File As NetFile In FilesWaiting
If NewThreadCount = 0 Then Exit For
If File.TryBeginThread() Then
IsSuccess = True
NewThreadCount -= 1
End If
Next
For Each File As NetFile In FilesLoading
If NewThreadCount = 0 Then Exit For
If File.TryBeginThread() Then
IsSuccess = True
NewThreadCount -= 1
End If
Next
'等待 40 ms：BMCLAPI 部分时候有 20QPS 的限制
Thread.Sleep(40)
Loop While NewThreadCount > 0 AndAlso IsSuccess
End If
'等待 40 ms
Thread.Sleep(40)
End While
Catch ex As Exception
Log(ex, "下载管理启动线程 2 出错", LogLevel.Assert)
End Try
End Sub, "NetManager ThreadStarter Odd")
End Sub
RunInNewThread(Sub() ThreadStarter(0), "NetManager ThreadStarter 0")
RunInNewThread(Sub() ThreadStarter(1), "NetManager ThreadStarter 1")
RunInNewThread(
Sub()
Try
@@ -1989,8 +1919,8 @@ Retry:
NetTaskSpeedLimitLeftLast = TimeNow
'刷新公开属性
RefreshStat()
'等待直至 170 ms
Do While GetTimeTick() - LastLoopTime < 170
'等待直至 80 ms
Do While GetTimeTick() - LastLoopTime < 80
Thread.Sleep(10)
Loop
End While
Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb
+7 -7
View File
@@ -414,10 +414,10 @@
Json("Website") = Website
If LastUpdate IsNot Nothing Then Json("LastUpdate") = LastUpdate
Json("DownloadCount") = DownloadCount
If ModLoaders IsNot Nothing AndAlso ModLoaders.Count > 0 Then Json("ModLoaders") = New JArray(ModLoaders.Select(Function(m) CInt(m)))
If ModLoaders IsNot Nothing AndAlso ModLoaders.Any Then Json("ModLoaders") = New JArray(ModLoaders.Select(Function(m) CInt(m)))
Json("Tags") = New JArray(Tags)
If LogoUrl IsNot Nothing Then Json("LogoUrl") = LogoUrl
If GameVersions.Count > 0 Then Json("GameVersions") = New JArray(GameVersions)
If GameVersions.Any Then Json("GameVersions") = New JArray(GameVersions)
Json("CacheTime") = Date.Now '用于检查缓存时间
Return Json
End Function
@@ -596,7 +596,7 @@
SubtitleList = SubtitleList.Distinct().ToList()
'设置标题与描述
Dim Subtitle As String = ""
If SubtitleList.Count > 0 Then
If SubtitleList.Any Then
For Each Ex In SubtitleList
Dim IsModLoaderDescription As Boolean =
Ex.ToLower.Contains("forge") OrElse Ex.ToLower.Contains("fabric") OrElse Ex.ToLower.Contains("quilt")
@@ -1356,9 +1356,9 @@ Retry:
Dim Info As String = ""
Select Case Type
Case CompType.Mod
Info += If(ModLoaders.Count > 0,
Info += If(ModLoaders.Any,
"适用于 " & Join(ModLoaders.Select(Function(m) GetStringFromEnum(m)).ToList, "/") & "，", "")
Info += If(ModeDebug AndAlso Dependencies.Count > 0, Dependencies.Count & " 个前置 Mod，", "")
Info += If(ModeDebug AndAlso Dependencies.Any, Dependencies.Count & " 个前置 Mod，", "")
Case CompType.ModPack
If GameVersions.All(Function(v) v.Contains("w")) Then
Info += $"游戏版本 {Join(GameVersions, "、")}，"
@@ -1452,7 +1452,7 @@ Retry:
SelectMany(Function(f) f.RawDependencies).Distinct().ToList
Dim UndoneDeps = Deps.Where(Function(f) Not CompProjectCache.ContainsKey(f)).ToList
'获取前置 Mod 工程信息
If UndoneDeps.Count > 0 Then
If UndoneDeps.Any Then
Log($"[Comp] {ProjectId} 文件列表中还需要获取信息的前置 Mod：{Join(UndoneDeps, "，")}")
Dim Projects As JArray
If TargetProject.FromCurseForge Then
@@ -1467,7 +1467,7 @@ Retry:
Next
End If
'更新前置 Mod 信息
If Deps.Count > 0 Then
If Deps.Any Then
For Each DepProject In Deps.Select(Function(id) CompProjectCache(id))
For Each File In CompFilesCache(ProjectId)
If File.RawDependencies.Contains(DepProject.Id) AndAlso DepProject.Id <> ProjectId Then
Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb
+22 -21
View File
@@ -94,7 +94,7 @@
Log(ex, "读取可能的崩溃日志文件失败（" & FilePath & "）")
End Try
Next
If LatestLog IsNot Nothing AndAlso LatestLog.Count > 0 Then
If LatestLog IsNot Nothing AndAlso LatestLog.Any Then
Dim RawOutput As String = Join(LatestLog, vbCrLf)
Log("[Crash] 以下为游戏输出的最后一段内容：" & vbCrLf & RawOutput)
WriteFile(TempFolder & "RawOutput.log", RawOutput)
@@ -110,21 +110,20 @@
Public Sub Import(FilePath As String)
Log("[Crash] 步骤 1：自主导入日志文件")
'解压压缩包
'尝试视作压缩包解压
Try
Dim Info As New FileInfo(FilePath)
If Not Info.Exists OrElse Info.Length = 0 Then Exit Try
If Not FilePath.EndsWithF(".jar", True) AndAlso ExtractFile(FilePath, TempFolder & "Temp\") Then
'解压成功
If Info.Exists AndAlso Info.Length > 0 AndAlso Not FilePath.EndsWithF(".jar", True) Then
ExtractFile(FilePath, TempFolder & "Temp\")
Log("[Crash] 已解压导入的日志文件：" & FilePath)
Else
'解压失败
CopyFile(FilePath, TempFolder & "Temp\" & GetFileNameFromPath(FilePath))
Log("[Crash] 已复制导入的日志文件：" & FilePath)
GoTo Extracted
End If
Catch ex As Exception
Log(ex, "解压导入文件中的压缩包失败")
Catch
End Try
'并非压缩包
CopyFile(FilePath, TempFolder & "Temp\" & GetFileNameFromPath(FilePath))
Log("[Crash] 已复制导入的日志文件：" & FilePath)
Extracted:
'导入其中的日志文件
For Each TargetFile As FileInfo In New DirectoryInfo(TempFolder & "Temp\").EnumerateFiles.ToList()
@@ -389,9 +388,9 @@
'1. 精准日志匹配，中/高优先级
AnalyzeCrit1()
If CrashReasons.Count > 0 Then GoTo Done
If CrashReasons.Any Then GoTo Done
AnalyzeCrit2()
If CrashReasons.Count > 0 Then GoTo Done
If CrashReasons.Any Then GoTo Done
'2. 堆栈分析
If LogAll.Contains("orge") OrElse LogAll.Contains("abric") OrElse LogAll.Contains("uilt") OrElse LogAll.Contains("iteloader") Then
@@ -406,7 +405,7 @@
If LogMc IsNot Nothing Then
Dim Fatals = RegexSearch(LogMc, "/FATAL] [\w\W]+?(?=[\n]+\[)")
Log("[Crash] 开始进行 Minecraft 日志堆栈分析，发现 " & Fatals.Count & " 个报错项")
If Fatals.Count > 0 Then
If Fatals.Any Then
For Each Fatal In Fatals
Keywords.AddRange(AnalyzeStackKeyword(Fatal))
Next
@@ -419,7 +418,7 @@
Keywords.AddRange(AnalyzeStackKeyword(StackLogs))
End If
'Mod 名称分析
If Keywords.Count > 0 Then
If Keywords.Any Then
Dim Names = AnalyzeModName(Keywords)
If Names Is Nothing Then
AppendReason(CrashReason.堆栈分析发现关键字, Keywords)
@@ -442,7 +441,7 @@ Done:
Else
Log("[Crash] 步骤 3：分析崩溃原因完成，找到 " & CrashReasons.Count & " 条可能的原因")
For Each Reason In CrashReasons
Log("[Crash] - " & GetStringFromEnum(Reason.Key) & If(Reason.Value.Count > 0, "（" & Join(Reason.Value, "；") & "）", ""))
Log("[Crash] - " & GetStringFromEnum(Reason.Key) & If(Reason.Value.Any, "（" & Join(Reason.Value, "；") & "）", ""))
Next
End If
End Sub
@@ -458,7 +457,7 @@ Done:
Else
CrashReasons.Add(Reason, New List(Of String)(If(Additional, {})))
End If
Log("[Crash] 可能的崩溃原因：" & GetStringFromEnum(Reason) & If(Additional IsNot Nothing AndAlso Additional.Count > 0, "（" & Join(Additional, "；") & "）", ""))
Log("[Crash] 可能的崩溃原因：" & GetStringFromEnum(Reason) & If(Additional IsNot Nothing AndAlso Additional.Any, "（" & Join(Additional, "；") & "）", ""))
End Sub
Private Sub AppendReason(Reason As CrashReason, Additional As String)
AppendReason(Reason, If(String.IsNullOrEmpty(Additional), Nothing, New List(Of String) From {Additional}))
@@ -567,7 +566,6 @@ Done:
End If
End If
If LogCrash.Contains("Multiple entries with same key: ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=Multiple entries with same key: )[^=]+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
If LogCrash.Contains("due to errors, provided by ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=due to errors, provided by ')[^']+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
If LogCrash.Contains("LoaderExceptionModCrash: Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=LoaderExceptionModCrash: Caught exception from )[^\n]+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
If LogCrash.Contains("Failed loading config file ") Then AppendReason(CrashReason.Mod配置文件导致游戏崩溃, {TryAnalyzeModName(If(RegexSeek(LogCrash, "(?<=Failed loading config file .+ for modid )[^\n]+"), "").TrimEnd(vbCrLf)).First, If(RegexSeek(LogCrash, "(?<=Failed loading config file ).+(?= of type)"), "").TrimEnd(vbCrLf)})
End If
@@ -612,6 +610,9 @@ Done:
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "[^./ \]]+(?=.mixins.json)")
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=mixins.)[^./ \]]+(?=.json)")
AppendReason(CrashReason.ModMixin失败, TryAnalyzeModName(If(ModId, "").TrimEnd((vbCrLf & " ").ToCharArray)))
Else
'在 #3104 的情况下，这一句导致 OptiFabric 的 Mixin 失败错判为 Fabric Loader 加载失败
If LogMc.Contains("due to errors, provided by ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=due to errors, provided by ')[^']+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
End If
'极短的程序输出
If Not (LogMc.Contains("at net.") OrElse LogMc.Contains("INFO]")) AndAlso LogHs Is Nothing AndAlso LogCrash Is Nothing AndAlso LogMc.Length < 100 Then
@@ -678,7 +679,7 @@ NextStack:
Next
PossibleWords = PossibleWords.Distinct.ToList
Log("[Crash] 从堆栈信息中找到 " & PossibleWords.Count & " 个可能的 Mod ID 关键词")
If PossibleWords.Count > 0 Then Log("[Crash] - " & Join(PossibleWords, ", "))
If PossibleWords.Any Then Log("[Crash] - " & Join(PossibleWords, ", "))
If PossibleWords.Count > 10 Then
Log("[Crash] 关键词过多，考虑匹配出错，不纳入考虑")
Return New List(Of String)
@@ -847,7 +848,7 @@ NextStack:
FileName = "游戏崩溃前的输出.txt"
End Select
If File.Exists(OutputFile) Then
WriteFile(TempFolder & "Report\" & FileName, SecretFilter(ReadFile(OutputFile)))
WriteFile(TempFolder & "Report\" & FileName, SecretFilter(ReadFile(OutputFile), If(FileName = "启动脚本.bat", "F", "*")))
End If
Next
'导出报告
@@ -903,7 +904,7 @@ NextStack:
Results.Add("你正在使用 32 位的操作系统，这会导致 Minecraft 无法使用所需的内存，进而造成崩溃。\n\n你或许只能重装 64 位的操作系统来解决此问题。\n如果你的电脑内存在 2GB 以内，那或许只能换台电脑了……\h")
End If
Case CrashReason.Mod缺少前置或MC版本错误
If Additional.Count > 0 Then
If Additional.Any Then
Results.Add("由于未满足 Mod 的依赖项，导致游戏退出。\n未满足的依赖项：\n - " & Join(Additional, "\n - ") & "\n\n请根据上述信息进行对应处理，如果看不懂英文可以使用翻译软件。")
Else
Results.Add("由于未满足 Mod 的依赖项，导致游戏退出。\n请根据错误报告中的日志信息进行对应处理，如果看不懂英文可以使用翻译软件。\h")
Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb
+4 -4
View File
@@ -79,7 +79,7 @@
Public Overrides Function ToString() As String
Dim VersionString = Version.ToString
If VersionString.StartsWithF("1.") Then VersionString = Mid(VersionString, 3)
Return If(IsJre, "JRE ", "JDK ") & VersionCode & " (" & VersionString & ")，" & If(Is64Bit, "64", "32") & " 位" & If(IsUserImport, "，手动导入", "") & "：" & PathFolder
Return If(IsJre, "JRE ", "JDK ") & VersionCode & " (" & VersionString & ")" & If(Is64Bit, "", "，32 位") & If(IsUserImport, "，手动导入", "") & "：" & PathFolder
End Function
'构造
@@ -220,7 +220,7 @@
Next
'检查特定的 Java
If TargetJavaList.Count > 0 Then
If TargetJavaList.Any Then
TargetJavaList = JavaCheckList(TargetJavaList)
Log("[Java] 检查后找到 " & TargetJavaList.Count & " 个特定路径下的 Java：")
For Each Java In TargetJavaList
@@ -534,7 +534,7 @@ NoUserJava:
Log("[Java] 位于 " & Folder & " 的 Java 不含符号链接")
JavaWithoutReparse.Add(Pair.Key, Pair.Value)
Next
If JavaWithoutReparse.Count > 0 Then JavaPreList = JavaWithoutReparse
If JavaWithoutReparse.Any Then JavaPreList = JavaWithoutReparse
'若不全为特殊引用，则清除特殊引用的地址
Dim JavaWithoutInherit As New Dictionary(Of String, Boolean)
@@ -546,7 +546,7 @@ NoUserJava:
JavaWithoutInherit.Add(Pair.Key, Pair.Value)
End If
Next
If JavaWithoutInherit.Count > 0 Then JavaPreList = JavaWithoutInherit
If JavaWithoutInherit.Any Then JavaPreList = JavaWithoutInherit
#End Region
Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb
+106 -36
View File
@@ -62,7 +62,7 @@ Public Module ModLaunch
''' 记录启动日志。
''' </summary>
Public Sub McLaunchLog(Text As String)
Text = SecretFilter(Text)
Text = SecretFilter(Text, "*")
RunInUi(Sub() FrmLaunchRight.LabLog.Text += vbCrLf & "[" & GetTimeNow() & "] " & Text)
Log("[Launch] " & Text)
End Sub
@@ -101,10 +101,10 @@ Public Module ModLaunch
'正式加载
Try
'构造主加载器
Dim LaunchLoader As New LoaderCombo(Of Object)("Minecraft 启动", {
New LoaderTask(Of Integer, Integer)("获取 Java", AddressOf McLaunchJava) With {.ProgressWeight = 4, .Block = False, .Show = False},
Dim Loaders As New List(Of LoaderBase) From {
New LoaderTask(Of Integer, Integer)("获取 Java", AddressOf McLaunchJava) With {.ProgressWeight = 4, .Block = False},
McLoginLoader,
New LoaderCombo(Of String)("补全文件", DlClientFix(McVersionCurrent, False, AssetsIndexExistsBehaviour.DownloadInBackground, True)) With {.ProgressWeight = 15, .Show = False, .Block = True},
New LoaderCombo(Of String)("补全文件", DlClientFix(McVersionCurrent, False, AssetsIndexExistsBehaviour.DownloadInBackground, True)) With {.ProgressWeight = 15, .Show = False},
New LoaderTask(Of String, List(Of McLibToken))("获取启动参数", AddressOf McLaunchArgumentMain) With {.ProgressWeight = 2},
New LoaderTask(Of List(Of McLibToken), Integer)("解压文件", AddressOf McLaunchNatives) With {.ProgressWeight = 2},
New LoaderTask(Of Integer, Integer)("预启动处理", AddressOf McLaunchPrerun) With {.ProgressWeight = 1},
@@ -112,7 +112,12 @@ Public Module ModLaunch
New LoaderTask(Of Integer, Process)("启动进程", AddressOf McLaunchRun) With {.ProgressWeight = 2},
New LoaderTask(Of Process, Integer)("等待游戏窗口出现", AddressOf McLaunchWait) With {.ProgressWeight = 1},
New LoaderTask(Of Integer, Integer)("结束处理", AddressOf McLaunchEnd) With {.ProgressWeight = 1}
}) With {.Show = False}
}
If Setup.Get("LaunchArgumentRam") Then
CType(Loaders(2), LoaderCombo(Of String)).Block = False
Loaders.Insert(3, New LoaderTask(Of Integer, Integer)("内存优化", AddressOf McLaunchMemoryOptimize) With {.ProgressWeight = 30})
End If
Dim LaunchLoader As New LoaderCombo(Of Object)("Minecraft 启动", Loaders) With {.Show = False}
If McLoginLoader.State = LoadState.Finished Then McLoginLoader.State = LoadState.Waiting '要求重启登录主加载器，它会自行决定是否启动副加载器
'等待加载器执行并更新 UI
McLaunchLoaderReal = LaunchLoader
@@ -163,6 +168,28 @@ NextInner:
#End Region
#Region "内存优化"
Private Sub McLaunchMemoryOptimize(Loader As LoaderTask(Of Integer, Integer))
McLaunchLog("内存优化开始")
Dim Finished As Boolean = False
RunInNewThread(
Sub()
PageOtherTest.MemoryOptimize(False)
Finished = True
End Sub, "Launch Memory Optimize")
Do While Not Finished AndAlso Not Loader.IsAborted
If Loader.Progress < 0.7 Then
Loader.Progress += 0.007 '10s
Else
Loader.Progress += (0.95 - Loader.Progress) * 0.02 '最快 += 0.005
End If
Thread.Sleep(100)
Loop
End Sub
#End Region
#Region "预检测"
Private Sub McLaunchPrecheck()
@@ -247,7 +274,7 @@ NextInner:
''' </summary>
Public BaseUrl As String
''' <summary>
''' 登录所使用的标识符，如 “Mojang”、“Nide”，用于存储缓存等。
''' 登录所使用的标识符，目前只可能为 “Auth” 或 “Nide”，用于存储缓存等。
''' </summary>
Public Token As String
''' <summary>
@@ -526,7 +553,13 @@ SkipLogin:
McLaunchLog("登录方式：" & Input.Description & "（" & LogUsername & "）")
Data.Progress = 0.05
'尝试登录
If (Not Data.Input.ForceReselectProfile) AndAlso Setup.Get("Cache" & Input.Token & "Username") = Data.Input.UserName AndAlso Setup.Get("Cache" & Input.Token & "Pass") = Data.Input.Password AndAlso Not Setup.Get("Cache" & Input.Token & "Access") = "" AndAlso Not Setup.Get("Cache" & Input.Token & "Client") = "" AndAlso Not Setup.Get("Cache" & Input.Token & "Uuid") = "" AndAlso Not Setup.Get("Cache" & Input.Token & "Name") = "" Then
If (Not Data.Input.ForceReselectProfile) AndAlso
Setup.Get("Cache" & Input.Token & "Username") = Data.Input.UserName AndAlso
Setup.Get("Cache" & Input.Token & "Pass") = Data.Input.Password AndAlso
Setup.Get("Cache" & Input.Token & "Access") <> "" AndAlso
Setup.Get("Cache" & Input.Token & "Client") <> "" AndAlso
Setup.Get("Cache" & Input.Token & "Uuid") <> "" AndAlso
Setup.Get("Cache" & Input.Token & "Name") <> "" Then
'尝试验证登录
Try
If Data.IsAborted Then Throw New ThreadInterruptedException
@@ -990,14 +1023,14 @@ SystemBrowser:
Case 1
'Steve
Do Until McSkinSex(Uuid) = "Steve"
If Uuid.EndsWithF("FFFFF") Then Uuid = Mid(Uuid, 1, 32 - 5) & "00000"
Uuid = Mid(Uuid, 1, 32 - 5) & (Long.Parse(Right(Uuid, 5), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X")
If Uuid.EndsWithF("FFFFF") Then Uuid = Uuid.Substring(0, 27) & "00000"
Uuid = Uuid.Substring(0, 27) & (Long.Parse(Uuid.Substring(27), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X").PadLeft(5, "0")
Loop
Case 2
'Alex
Do Until McSkinSex(Uuid) = "Alex"
If Uuid.EndsWithF("FFFFF") Then Uuid = Mid(Uuid, 1, 32 - 5) & "00000"
Uuid = Mid(Uuid, 1, 32 - 5) & (Long.Parse(Right(Uuid, 5), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X")
If Uuid.EndsWithF("FFFFF") Then Uuid = Uuid.Substring(0, 27) & "00000"
Uuid = Uuid.Substring(0, 27) & (Long.Parse(Uuid.Substring(27), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X").PadLeft(5, "0")
Loop
Case 3
'使用正版用户名
@@ -1096,22 +1129,25 @@ SystemBrowser:
If McVersionCurrent.Version.HasForge Then
If McVersionCurrent.Version.McName = "1.7.2" Then
'1.7.2：必须 Java 7
MinVer = New Version(1, 7, 0, 0) : MaxVer = New Version(1, 7, 999, 999)
MinVer = If(New Version(1, 7, 0, 0) > MinVer, New Version(1, 7, 0, 0), MinVer)
MaxVer = If(New Version(1, 7, 999, 999) < MaxVer, New Version(1, 7, 999, 999), MaxVer)
ElseIf McVersionCurrent.Version.McCodeMain <= 12 AndAlso McVersionCurrent.Version.McCodeMain > 0 Then
'<=1.12：Java 8
MaxVer = New Version(1, 8, 999, 999)
ElseIf McVersionCurrent.Version.McCodeMain <= 14 AndAlso McVersionCurrent.Version.McCodeMain >= 13 Then
'1.13 - 1.14：Java 8 - 10
MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 10, 999, 999)
MinVer = If(New Version(1, 8, 0, 0) > MinVer, New Version(1, 8, 0, 0), MinVer)
MaxVer = If(New Version(1, 10, 999, 999) < MaxVer, New Version(1, 10, 999, 999), MaxVer)
ElseIf McVersionCurrent.Version.McCodeMain = 15 Then
'1.15：Java 8 - 15
MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 15, 999, 999)
MinVer = If(New Version(1, 8, 0, 0) > MinVer, New Version(1, 8, 0, 0), MinVer)
MaxVer = If(New Version(1, 15, 999, 999) < MaxVer, New Version(1, 15, 999, 999), MaxVer)
ElseIf VersionSortBoolean(McVersionCurrent.Version.ForgeVersion, "34.0.0") AndAlso VersionSortBoolean("36.2.25", McVersionCurrent.Version.ForgeVersion) Then
'1.16，Forge 34.X ~ 36.2.25：最高 Java 8u320
MaxVer = New Version(1, 8, 0, 320)
MaxVer = If(New Version(1, 8, 0, 320) < MaxVer, New Version(1, 8, 0, 320), MaxVer)
ElseIf McVersionCurrent.Version.McCodeMain >= 18 AndAlso McVersionCurrent.Version.McCodeMain < 19 AndAlso McVersionCurrent.Version.HasOptiFine Then '#305
'1.18：若安装了 OptiFine，最高 Java 18
MaxVer = New Version(1, 18, 999, 999)
MaxVer = If(New Version(1, 18, 999, 999) < MaxVer, New Version(1, 18, 999, 999), MaxVer)
End If
End If
@@ -1119,10 +1155,10 @@ SystemBrowser:
If McVersionCurrent.Version.HasFabric Then
If McVersionCurrent.Version.McCodeMain >= 15 AndAlso McVersionCurrent.Version.McCodeMain <= 16 AndAlso McVersionCurrent.Version.McCodeMain <> -1 Then
'1.15 - 1.16：Java 8+
MinVer = New Version(1, 8, 0, 0)
MinVer = If(New Version(1, 8, 0, 0) > MinVer, New Version(1, 8, 0, 0), MinVer)
ElseIf McVersionCurrent.Version.McCodeMain >= 18 AndAlso McVersionCurrent.Version.McCodeMain < 99 Then
'1.18+：Java 17+
MinVer = New Version(1, 17, 0, 0)
MinVer = If(New Version(1, 17, 0, 0) > MinVer, New Version(1, 17, 0, 0), MinVer)
End If
End If
@@ -1202,17 +1238,20 @@ SystemBrowser:
''' </summary>
Public Function ExtractJavaWrapper() As String
Dim WrapperPath As String = GetJavaWrapperDir() & "\JavaWrapper.jar"
WriteFile(WrapperPath, GetResources("JavaWrapper"))
SyncLock ExtractJavaWrapperLock '避免 OptiFine 和 Forge 安装时同时释放 Java Wrapper 导致冲突
WriteFile(WrapperPath, GetResources("JavaWrapper"))
End SyncLock
Log("[Java] 已释放 Java Wrapper：" & WrapperPath)
Return WrapperPath
End Function
Private ExtractJavaWrapperLock As New Object
''' <summary>
''' 获取 Java Wrapper 所在的文件夹，不以 \ 结尾。
''' </summary>
Public Function GetJavaWrapperDir() As String
If Encoding.UTF8.GetByteCount(PathAppdata) = PathAppdata.Length Then
If PathAppdata.IsASCII() Then
Return PathAppdata.TrimEnd("\")
ElseIf Encoding.UTF8.GetByteCount(PathTemp) = PathTemp.Length Then
ElseIf PathTemp.IsASCII() Then
Log("[Java] Wrapper：AppData 路径中包含非 ASCII 字符，换用 Temp 目录")
Return PathTemp.TrimEnd("\")
Else
@@ -1276,9 +1315,7 @@ SystemBrowser:
'不包含端口号
Arguments += " --server " & Server & " --port 25565"
End If
If McVersionCurrent.Version.HasOptiFine Then 'OptiFine 警告
Hint("OptiFine 与自动进入服务器可能不兼容，有概率导致材质丢失甚至游戏崩溃！", HintType.Critical)
End If
If McVersionCurrent.Version.HasOptiFine Then Hint("OptiFine 与自动进入服务器可能不兼容，有概率导致材质丢失甚至游戏崩溃！", HintType.Critical)
End If
End If
'自定义
@@ -1300,10 +1337,11 @@ SystemBrowser:
Dim ArgumentJvm As String = Setup.Get("VersionAdvanceJvm", Version:=McVersionCurrent)
If ArgumentJvm = "" Then ArgumentJvm = Setup.Get("LaunchAdvanceJvm")
If Not ArgumentJvm.Contains("-Dlog4j2.formatMsgNoLookups=true") Then ArgumentJvm += " -Dlog4j2.formatMsgNoLookups=true"
ArgumentJvm = ArgumentJvm.Replace(" -XX:MaxDirectMemorySize=256M", "") '#3511 的清理
DataList.Insert(0, ArgumentJvm) '可变 JVM 参数
DataList.Add("-Xmn256m")
DataList.Add("-Xmn" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) * 1024 * 0.5) & "m")
DataList.Add("-Xmx" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) * 1024) & "m")
DataList.Add("""-Djava.library.path=" & Version.Path & Version.Name & "-natives""")
DataList.Add("""-Djava.library.path=" & GetNativesFolder() & """")
DataList.Add("-cp ${classpath}") '把支持库添加进启动参数表
'统一通行证
@@ -1415,6 +1453,9 @@ NextVersion:
DeDuplicateDataList.Add(CurrentEntry.Trim.Replace("McEmu= ", "McEmu="))
Next
'#3511 的清理
DeDuplicateDataList.Remove("-XX:MaxDirectMemorySize=256M")
'去重
Dim Result As String = Join(DeDuplicateDataList.Distinct.ToList, " ")
@@ -1535,7 +1576,7 @@ NextVersion:
'基础参数
GameArguments.Add("${classpath_separator}", ";")
GameArguments.Add("${natives_directory}", Version.Path & Version.Name & "-natives")
GameArguments.Add("${natives_directory}", GetNativesFolder())
GameArguments.Add("${library_directory}", PathMcFolder & "libraries")
GameArguments.Add("${libraries_directory}", PathMcFolder & "libraries")
GameArguments.Add("${launcher_name}", "PCL")
@@ -1552,9 +1593,26 @@ NextVersion:
GameArguments.Add("${access_token}", McLoginLoader.Output.AccessToken)
GameArguments.Add("${auth_session}", McLoginLoader.Output.AccessToken)
GameArguments.Add("${user_type}", "msa") '#1221
Dim GameSize As Size = Setup.GetLaunchArgumentWindowSize()
GameArguments.Add("${resolution_width}", GameSize.Width)
GameArguments.Add("${resolution_height}", GameSize.Height)
'窗口尺寸参数
Dim GameSize As Size
Select Case Setup.Get("LaunchArgumentWindowType")
Case 2
Dim Result As Size
RunInUiWait(Sub() Result = New Size(GetPixelSize(FrmMain.PanForm.ActualWidth), GetPixelSize(FrmMain.PanForm.ActualHeight)))
GameSize = Result
Case 3
GameSize = New Size(Math.Max(100, Setup.Get("LaunchArgumentWindowWidth") - 2), Math.Max(100, Setup.Get("LaunchArgumentWindowHeight") - 2))
Case Else
GameSize = New Size(875 - 2, 540 - 2)
End Select
GameSize.Height -= 29.5 * DPI / 96 '标题栏高度
If McVersionCurrent.Version.McCodeMain <= 12 AndAlso McLaunchJavaSelected.VersionCode <= 8 Then '修复 #3463：1.12.2-，JRE 8 下窗口大小为设置大小的 DPI% 倍
GameSize.Width /= DPI / 96
GameSize.Height /= DPI / 96
End If
GameArguments.Add("${resolution_width}", Math.Round(GameSize.Width))
GameArguments.Add("${resolution_height}", Math.Round(GameSize.Height))
'Assets 相关参数
GameArguments.Add("${game_assets}", PathMcFolder & "assets\virtual\legacy") '1.5.2 的 pre-1.6 资源索引应与 legacy 合并
@@ -1586,7 +1644,8 @@ NextVersion:
Private Sub McLaunchNatives(Loader As LoaderTask(Of List(Of McLibToken), Integer))
'创建文件夹
Directory.CreateDirectory(McVersionCurrent.Path & McVersionCurrent.Name & "-natives")
Dim Target As String = GetNativesFolder() & "\"
Directory.CreateDirectory(Target)
'解压文件
McLaunchLog("正在解压 Natives 文件")
@@ -1605,7 +1664,7 @@ NextVersion:
Dim FileName As String = Entry.FullName
If FileName.EndsWithF(".dll", True) Then
'实际解压文件的步骤
Dim FilePath As String = McVersionCurrent.Path & McVersionCurrent.Name & "-natives\" & FileName
Dim FilePath As String = Target & FileName
ExistFiles.Add(FilePath)
Dim OriginalFile As New FileInfo(FilePath)
If OriginalFile.Exists Then
@@ -1631,7 +1690,7 @@ NextVersion:
Next
'删除多余文件
For Each FileName As String In Directory.GetFiles(McVersionCurrent.Path & McVersionCurrent.Name & "-natives")
For Each FileName As String In Directory.GetFiles(Target)
If ExistFiles.Contains(FileName) Then Continue For
Try
McLaunchLog("删除：" & FileName)
@@ -1644,6 +1703,16 @@ NextVersion:
Next
End Sub
''' <summary>
''' 获取 Natives 文件夹路径，不以 \ 结尾。
''' </summary>
Private Function GetNativesFolder() As String
Dim Result As String = McVersionCurrent.Path & McVersionCurrent.Name & "-natives"
If IsGBKEncoding OrElse Result.IsASCII() Then Return Result
Result = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\bin\natives"
If Result.IsASCII() Then Return Result
Return OsDrive & "ProgramData\PCL\natives"
End Function
#End Region
@@ -1758,7 +1827,7 @@ NextVersion:
Select Case Setup.Get("LaunchArgumentWindowType")
Case 0 '全屏
WriteIni(SetupFileAddress, "fullscreen", "true")
Case 5 '保持默认
Case 1 '默认
Case Else '其他
WriteIni(SetupFileAddress, "fullscreen", "false")
End Select
@@ -1936,7 +2005,7 @@ IgnoreCustomSkin:
"""" & McLaunchJavaSelected.PathJava & """ " & McLaunchArgument & vbCrLf &
"echo 游戏已退出。" & vbCrLf &
"pause"
WriteFile(If(McLaunchLoader.Input.SaveBatch, Path & "PCL\LatestLaunch.bat"), SecretFilter(CmdString),
WriteFile(If(McLaunchLoader.Input.SaveBatch, Path & "PCL\LatestLaunch.bat"), SecretFilter(CmdString, "F"),
Encoding:=If(Encoding.Default.Equals(Encoding.UTF8), Encoding.UTF8, Encoding.GetEncoding("GB18030")))
If McLaunchLoader.Input.SaveBatch IsNot Nothing Then
McLaunchLog("导出启动脚本完成，强制结束启动过程")
@@ -2058,7 +2127,7 @@ IgnoreCustomSkin:
McLaunchLog("")
McLaunchLog("~ 基础参数 ~")
McLaunchLog("PCL 版本：" & VersionDisplayName & " (" & VersionCode & ")")
McLaunchLog("游戏版本：" & McVersionCurrent.Version.ToString & "（" & McVersionCurrent.Version.McCodeMain & "." & McVersionCurrent.Version.McCodeSub & "）")
McLaunchLog("游戏版本：" & McVersionCurrent.Version.ToString & "（识别为 1." & McVersionCurrent.Version.McCodeMain & "." & McVersionCurrent.Version.McCodeSub & "）")
McLaunchLog("资源版本：" & McAssetsGetIndexName(McVersionCurrent))
McLaunchLog("版本继承：" & If(McVersionCurrent.InheritVersion = "", "无", McVersionCurrent.InheritVersion))
McLaunchLog("分配的内存：" & PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) & " GB（" & Math.Round(PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) * 1024) & " MB）")
@@ -2068,6 +2137,7 @@ IgnoreCustomSkin:
McLaunchLog("HMCL 格式：" & McVersionCurrent.IsHmclFormatJson)
McLaunchLog("Java 信息：" & If(McLaunchJavaSelected IsNot Nothing, McLaunchJavaSelected.ToString, "无可用 Java"))
McLaunchLog("环境变量：" & If(McLaunchJavaSelected IsNot Nothing, If(McLaunchJavaSelected.HasEnvironment, "已设置", "未设置"), "未设置"))
McLaunchLog("Natives 文件夹：" & GetNativesFolder())
McLaunchLog("")
McLaunchLog("~ 登录参数 ~")
McLaunchLog("玩家用户名：" & McLoginLoader.Output.Name)
Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb
+15 -15
View File
@@ -181,7 +181,7 @@
If AniControlEnabled = 0 AndAlso
Setup.Get("VersionServerAuthServer", Version:=value) <> Setup.Get("CacheAuthServerServer") AndAlso
Setup.Get("VersionServerLogin", Version:=value) = 4 Then
Setup.Set("CacheNideServer", "")
Setup.Set("CacheAuthAccess", "")
Log("[Launch] 服务器改变，要求重新登录 Authlib-Injector")
End If
If Setup.Get("VersionServerLogin", Version:=value) = 4 Then
@@ -216,8 +216,8 @@
'尚未判断
Dim ModFolder As New DirectoryInfo(Path & "mods\")
Dim SaveFolder As New DirectoryInfo(Path & "saves\")
If (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Count > 0) OrElse
(SaveFolder.Exists AndAlso SaveFolder.EnumerateFiles.Count > 0) Then
If (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Any) OrElse
(SaveFolder.Exists AndAlso SaveFolder.EnumerateFiles.Any) Then
'自动开启
Setup.Set("VersionArgumentIndie", 1, Version:=Me)
Log("[Setup] 已自动开启单版本隔离：" & Name)
@@ -1234,7 +1234,7 @@ OnLoaded:
For Each Version As McVersion In VersionList
If Version.IsStar AndAlso Not Version.DisplayType = McVersionCardType.Hidden Then StaredVersions.Add(Version)
Next
If StaredVersions.Count > 0 Then VersionListOriginal.Add(McVersionCardType.Star, StaredVersions)
If StaredVersions.Any Then VersionListOriginal.Add(McVersionCardType.Star, StaredVersions)
'预先筛选出愚人节的版本
McVersionFilter(VersionList, VersionListOriginal, {McVersionState.Error}, McVersionCardType.Error)
@@ -1308,8 +1308,8 @@ OnLoaded:
'将剩余的东西添加进去
VersionRubbish.AddRange(VersionList)
If VersionUseful.Count > 0 Then VersionListOriginal.Add(McVersionCardType.OriginalLike, VersionUseful)
If VersionRubbish.Count > 0 Then VersionListOriginal.Add(McVersionCardType.Rubbish, VersionRubbish)
If VersionUseful.Any Then VersionListOriginal.Add(McVersionCardType.OriginalLike, VersionUseful)
If VersionRubbish.Any Then VersionListOriginal.Add(McVersionCardType.Rubbish, VersionRubbish)
'按照自定义版本分类重新添加
For Each VersionPair In VersionListOriginal
@@ -1429,7 +1429,7 @@ OnLoaded:
NextVersion:
Next
'加入版本列表，并从剩余中删除
If KeepList.Count > 0 Then
If KeepList.Any Then
Target.Add(CardType, KeepList)
For Each Version As McVersion In KeepList
VersionList.Remove(Version)
@@ -1450,7 +1450,7 @@ NextVersion:
Next
NextVersion:
Next
If KeepList.Count > 0 Then
If KeepList.Any Then
For Each Version As McVersion In KeepList
VersionList.Remove(Version)
Next
@@ -1515,7 +1515,7 @@ NextVersion:
''' </summary>
Public Function McSkinGetAddress(Uuid As String, Type As String) As String
If Uuid = "" Then Throw New Exception("Uuid 为空。")
If Uuid.StartsWithF("000000") Then Throw New Exception("离线 Uuid 无正版皮肤文件。")
If Uuid.StartsWithF("00000") Then Throw New Exception("离线 Uuid 无正版皮肤文件。")
'尝试读取缓存
Dim CacheSkinAddress As String = ReadIni(PathTemp & "Cache\Skin\Index" & Type & ".ini", Uuid)
If Not CacheSkinAddress = "" Then Return CacheSkinAddress
@@ -2048,8 +2048,7 @@ NextVersion:
If Version.InheritVersion = "" Then Exit Do
Version = New McVersion(PathMcFolder & "versions\" & Version.InheritVersion)
Loop
Catch ex As Exception
Log(ex, "获取资源文件索引下载地址失败")
Catch
End Try
'无法获取到下载地址
If ReturnLegacyOnError Then
@@ -2239,10 +2238,11 @@ NextVersion:
'弹窗结果
If MsgResult = 2 Then
'下载
RunInUi(Sub()
PageDownloadInstall.McVersionWaitingForSelect = VersionName
FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadInstall)
End Sub)
RunInUi(
Sub()
PageDownloadInstall.McVersionWaitingForSelect = VersionName
FrmMain.PageChange(FormMain.PageType.Download, FormMain.PageSubType.DownloadInstall)
End Sub)
End If
Catch ex As Exception
Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb
+5 -4
View File
@@ -337,7 +337,7 @@ Public Module ModMod
For Each Token In AuthorJson
Author.Add(Token.ToString)
Next
If Author.Count > 0 Then Authors = Join(Author, ", ")
If Author.Any Then Authors = Join(Author, ", ")
End If
Dim Reqs As JArray = InfoObject("requiredMods")
If Reqs IsNot Nothing Then
@@ -393,7 +393,7 @@ GotFabric:
For Each Token In AuthorJson
Author.Add(Token.ToString)
Next
If Author.Count > 0 Then Authors = Join(Author, ", ")
If Author.Any Then Authors = Join(Author, ", ")
End If
'If (Not FabricObject.ContainsKey("serverSideOnly")) OrElse FabricObject("serverSideOnly")("value").ToObject(Of Boolean) = False Then
' '添加 Minecraft 依赖
@@ -438,7 +438,7 @@ GotFabric:
Line = Line.Substring(0, Line.IndexOfF("#"))
End If
Line = Line.Trim(New Char() {" "c, " "c, "　"c}) '去除头尾的空格
If Line.Count > 0 Then Lines.Add(Line) '去除空行
If Line.Any Then Lines.Add(Line) '去除空行
Next
'读取文件数据
Dim TomlData As New List(Of KeyValuePair(Of String, Dictionary(Of String, Object))) From {New KeyValuePair(Of String, Dictionary(Of String, Object))("", New Dictionary(Of String, Object))}
@@ -925,7 +925,7 @@ Finished:
End Sub
'联网加载 Mod 详情
Private Const LocalModCacheVersion As Integer = 2
Private Const LocalModCacheVersion As Integer = 3
Public McModDetailLoader As New LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer)("Mod List Detail Loader", AddressOf McModDetailLoad)
Private Sub McModDetailLoad(Loader As LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer))
Dim Mods As List(Of McMod) = Loader.Input.Key
@@ -965,6 +965,7 @@ Finished:
Dim ModrinthMapping As New Dictionary(Of String, List(Of McMod))
For Each Entry In Mods
If Not ModrinthVersion.ContainsKey(Entry.ModrinthHash) Then Continue For
If ModrinthVersion(Entry.ModrinthHash)("files")(0)("hashes")("sha1") <> Entry.ModrinthHash Then Continue For
Dim ProjectId = ModrinthVersion(Entry.ModrinthHash)("project_id").ToString
If CompProjectCache.ContainsKey(ProjectId) AndAlso Entry.Comp Is Nothing Then Entry.Comp = CompProjectCache(ProjectId) '读取已加载的缓存，加快结果出现速度
If Not ModrinthMapping.ContainsKey(ProjectId) Then ModrinthMapping(ProjectId) = New List(Of McMod)
Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb
+59 -95
View File
@@ -244,16 +244,17 @@ Retry:
ModList.Add(ModEntry("fileID"))
If ModEntry("required") IsNot Nothing AndAlso Not ModEntry("required").ToObject(Of Boolean) Then ModOptionalList.Add(ModEntry("fileID"))
Next
If ModList.Count > 0 Then
If ModList.Any Then
Dim ModDownloadLoaders As New List(Of LoaderBase)
'获取 Mod 下载信息
InstallLoaders.Add(New LoaderTask(Of Integer, JArray)("获取 Mod 下载信息",
ModDownloadLoaders.Add(New LoaderTask(Of Integer, JArray)("获取 Mod 下载信息",
Sub(Task As LoaderTask(Of Integer, JArray))
Task.Output = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(ModList, ",") & "]}", "application/json"))("data")
'如果文件已被删除，则 API 会跳过那一项
If ModList.Count > Task.Output.Count Then Throw New Exception("整合包所需要的部分 Mod 版本已被 Mod 作者删除，因此无法完成整合包安装，请联系整合包作者更新整合包中的 Mod 版本")
End Sub) With {.ProgressWeight = ModList.Count / 10}) '每 10 Mod 需要 1s
'构造 NetFile
InstallLoaders.Add(New LoaderTask(Of JArray, List(Of NetFile))("构造 Mod 下载信息",
ModDownloadLoaders.Add(New LoaderTask(Of JArray, List(Of NetFile))("构造 Mod 下载信息",
Sub(Task As LoaderTask(Of JArray, List(Of NetFile)))
Dim FileList As New Dictionary(Of Integer, NetFile)
For Each ModJson In Task.Input
@@ -288,7 +289,10 @@ Retry:
Task.Output = FileList.Values.ToList
End Sub) With {.ProgressWeight = ModList.Count / 200, .Show = False}) '每 200 Mod 需要 1s
'下载 Mod 文件
InstallLoaders.Add(New LoaderDownload("下载 Mod", New List(Of NetFile)) With {.ProgressWeight = ModList.Count * 1.5}) '每个 Mod 需要 1.5s
ModDownloadLoaders.Add(New LoaderDownload("下载 Mod", New List(Of NetFile)) With {.ProgressWeight = ModList.Count * 1.5}) '每个 Mod 需要 1.5s
'构造加载器
InstallLoaders.Add(New LoaderCombo(Of Integer)("下载 Mod（主加载器）", ModDownloadLoaders) With
{.Show = False, .ProgressWeight = ModDownloadLoaders.Sum(Function(l) l.ProgressWeight)})
End If
'构造加载器
@@ -299,43 +303,35 @@ Retry:
.ForgeVersion = ForgeVersion,
.FabricVersion = FabricVersion
}
Dim InstallExpectTime As Double = 0
For Each InstallLoader In InstallLoaders
InstallExpectTime += InstallLoader.ProgressWeight
Next
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Exit Sub
Dim MergeExpectTime As Double = 0
For Each MergeLoader In MergeLoaders
MergeExpectTime += MergeLoader.ProgressWeight
Next
'构造 Libraries 加载器（为了使得 Mods 下载结束后再构造，这样才会下载 JumpLoader 文件）
'构造 Libraries 加载器
Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件（副加载器）", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
LoadersLib.Add(New LoaderDownload("下载游戏支持库文件（副加载器）", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
'构造总加载器
Dim Loaders As New List(Of LoaderBase)
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallExpectTime})
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeExpectTime})
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)})
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
Loaders.Add(New LoaderTask(Of String, String)("最终整理文件",
Sub(Task As LoaderTask(Of String, String))
'设置图标
Dim VersionFolder As String = PathMcFolder & "versions\" & VersionName & "\"
If Logo IsNot Nothing AndAlso File.Exists(Logo) Then
File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
WriteIni(VersionFolder & "PCL\Setup.ini", "LogoCustom", "True")
Log("[ModPack] 已设置整合包 Logo：" & Logo)
End If
'删除原始整合包文件
For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
If Not Setup.Get("ToolDownloadKeepModpack") AndAlso File.Exists(Target) Then
Log("[ModPack] 根据设置要求删除原始整合包文件：" & Target)
File.Delete(Target)
End If
Next
End Sub) With {.ProgressWeight = 0.1, .Show = False})
Sub(Task As LoaderTask(Of String, String))
'设置图标
Dim VersionFolder As String = PathMcFolder & "versions\" & VersionName & "\"
If Logo IsNot Nothing AndAlso File.Exists(Logo) Then
File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
WriteIni(VersionFolder & "PCL\Setup.ini", "LogoCustom", "True")
Log("[ModPack] 已设置整合包 Logo：" & Logo)
End If
'删除原始整合包文件
For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
If Not Setup.Get("ToolDownloadKeepModpack") AndAlso File.Exists(Target) Then
Log("[ModPack] 根据设置要求删除原始整合包文件：" & Target)
File.Delete(Target)
End If
Next
End Sub) With {.ProgressWeight = 0.1, .Show = False})
'重复任务检查
Dim LoaderName As String = "CurseForge 整合包安装：" & VersionName & " "
@@ -438,10 +434,10 @@ Retry:
End If
'添加下载文件
FileList.Add(New NetFile(File("downloads").Select(Function(t) t.ToString.Replace("://edge.forgecdn", "://media.forgecdn")).ToArray, '修复 #2390
PathMcFolder & "versions\" & VersionName & "\" & File("path").ToString,
New FileChecker(ActualSize:=File("fileSize").ToObject(Of Long), Hash:=File("hashes")("sha1").ToString), True))
PathMcFolder & "versions\" & VersionName & "\" & File("path").ToString,
New FileChecker(ActualSize:=File("fileSize").ToObject(Of Long), Hash:=File("hashes")("sha1").ToString), True))
Next
If FileList.Count > 0 Then
If FileList.Any Then
InstallLoaders.Add(New LoaderDownload("下载额外文件", FileList) With {.ProgressWeight = FileList.Count * 1.5}) '每个 Mod 需要 1.5s
End If
@@ -453,43 +449,35 @@ Retry:
.ForgeVersion = ForgeVersion,
.FabricVersion = FabricVersion
}
Dim InstallExpectTime As Double = 0
For Each InstallLoader In InstallLoaders
InstallExpectTime += InstallLoader.ProgressWeight
Next
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Exit Sub
Dim MergeExpectTime As Double = 0
For Each MergeLoader In MergeLoaders
MergeExpectTime += MergeLoader.ProgressWeight
Next
'构造 Libraries 加载器（为了使得 Mods 下载结束后再构造，这样才会下载 JumpLoader 文件）
'构造 Libraries 加载器
Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件（副加载器）", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
LoadersLib.Add(New LoaderDownload("下载游戏支持库文件（副加载器）", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
'构造总加载器
Dim Loaders As New List(Of LoaderBase)
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallExpectTime})
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeExpectTime})
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .Block = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)})
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
Loaders.Add(New LoaderTask(Of String, String)("最终整理文件",
Sub(Task As LoaderTask(Of String, String))
'设置图标
Dim VersionFolder As String = PathMcFolder & "versions\" & VersionName & "\"
If Logo IsNot Nothing AndAlso File.Exists(Logo) Then
File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
WriteIni(VersionFolder & "PCL\Setup.ini", "LogoCustom", "True")
Log("[ModPack] 已设置整合包 Logo：" & Logo)
End If
'删除原始整合包文件
For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
If Not Setup.Get("ToolDownloadKeepModpack") AndAlso File.Exists(Target) Then
Log("[ModPack] 根据设置要求删除原始整合包文件：" & Target)
File.Delete(Target)
End If
Next
End Sub) With {.ProgressWeight = 0.1, .Show = False})
Sub(Task As LoaderTask(Of String, String))
'设置图标
Dim VersionFolder As String = PathMcFolder & "versions\" & VersionName & "\"
If Logo IsNot Nothing AndAlso File.Exists(Logo) Then
File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
WriteIni(VersionFolder & "PCL\Setup.ini", "LogoCustom", "True")
Log("[ModPack] 已设置整合包 Logo：" & Logo)
End If
'删除原始整合包文件
For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
If Not Setup.Get("ToolDownloadKeepModpack") AndAlso File.Exists(Target) Then
Log("[ModPack] 根据设置要求删除原始整合包文件：" & Target)
File.Delete(Target)
End If
Next
End Sub) With {.ProgressWeight = 0.1, .Show = False})
'重复任务检查
Dim LoaderName As String = "Modrinth 整合包安装：" & VersionName & " "
@@ -554,16 +542,8 @@ Retry:
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
.MinecraftName = Json("gameVersion").ToString
}
Dim InstallExpectTime As Double = 0
For Each InstallLoader In InstallLoaders
InstallExpectTime += InstallLoader.ProgressWeight
Next
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Exit Sub
Dim MergeExpectTime As Double = 0
For Each MergeLoader In MergeLoaders
MergeExpectTime += MergeLoader.ProgressWeight
Next
'构造 Libraries 加载器（为了使得 Mods 下载结束后再构造，这样才会下载 JumpLoader 文件）
Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, String)("重命名版本 Json（副加载器）",
@@ -584,8 +564,8 @@ Retry:
LoadersLib.Add(New LoaderDownload("下载游戏支持库文件（副加载器）", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
'构造总加载器
Dim Loaders As New List(Of LoaderBase) From {
New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeExpectTime},
New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallExpectTime},
New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)},
New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)},
New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8}
}
@@ -704,24 +684,16 @@ Retry:
End Select
Next
'构造加载器
Dim InstallExpectTime As Double = 0
For Each InstallLoader In InstallLoaders
InstallExpectTime += InstallLoader.ProgressWeight
Next
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Exit Sub
Dim MergeExpectTime As Double = 0
For Each MergeLoader In MergeLoaders
MergeExpectTime += MergeLoader.ProgressWeight
Next
'构造 Libraries 加载器（为了使得 Mods 下载结束后再构造，这样才会下载 JumpLoader 文件）
'构造 Libraries 加载器
Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件（副加载器）", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
LoadersLib.Add(New LoaderDownload("下载游戏支持库文件（副加载器）", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
'构造总加载器
Dim Loaders As New List(Of LoaderBase)
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeExpectTime})
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallExpectTime})
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)})
Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
'重复任务检查
@@ -802,24 +774,16 @@ Retry:
.ForgeVersion = If(Addons.ContainsKey("forge"), Addons("forge"), Nothing),
.FabricVersion = If(Addons.ContainsKey("fabric"), Addons("fabric"), Nothing)
}
Dim InstallExpectTime As Double = 0
For Each InstallLoader In InstallLoaders
InstallExpectTime += InstallLoader.ProgressWeight
Next
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
If MergeLoaders Is Nothing Then Exit Sub
Dim MergeExpectTime As Double = 0
For Each MergeLoader In MergeLoaders
MergeExpectTime += MergeLoader.ProgressWeight
Next
'构造 Libraries 加载器（为了使得 Mods 下载结束后再构造，这样才会下载 JumpLoader 文件）
'构造 Libraries 加载器
Dim LoadersLib As New List(Of LoaderBase)
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件（副加载器）", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
LoadersLib.Add(New LoaderDownload("下载游戏支持库文件（副加载器）", New List(Of NetFile)) With {.ProgressWeight = 7, .Show = False})
'构造总加载器
Dim Loaders As New List(Of LoaderBase)
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeExpectTime})
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallExpectTime})
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .Block = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
Loaders.Add(New LoaderCombo(Of String)("整合包安装", InstallLoaders) With {.Show = False, .ProgressWeight = InstallLoaders.Sum(Function(l) l.ProgressWeight)})
Loaders.Add(New LoaderCombo(Of String)("下载游戏支持库文件", LoadersLib) With {.ProgressWeight = 8})
'重复任务检查
Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb
+12 -11
View File
@@ -276,17 +276,18 @@
IsWindowFinished = True
'最大化
If Setup.Get("LaunchArgumentWindowType") = 4 Then
RunInNewThread(Sub()
Try
'如果最大化导致屏幕渲染大小不对，那是 MC 的 Bug，不是我的 Bug
'……虽然我很想这样说，但总有人反馈，算了
Thread.Sleep(2000)
ShowWindow(WindowHandle, 3)
WatcherLog($"已最大化 Minecraft 窗口：{MinecraftWindowHandle.ToInt64}")
Catch ex As Exception
Log(ex, "最大化 Minecraft 窗口时出现错误")
End Try
End Sub, "MinecraftWindowMaximize")
RunInNewThread(
Sub()
Try
'如果最大化导致屏幕渲染大小不对，那是 MC 的 Bug，不是我的 Bug
'……虽然我很想这样说，但总有人反馈，算了
Thread.Sleep(2000)
ShowWindow(WindowHandle, 3)
WatcherLog($"已最大化 Minecraft 窗口：{MinecraftWindowHandle.ToInt64}")
Catch ex As Exception
Log(ex, "最大化 Minecraft 窗口时出现错误")
End Try
End Sub, "MinecraftWindowMaximize")
End If
ElseIf Not IsWindowAppeared Then
'已找到 FML 窗口
Plain Craft Launcher 2/Modules/ModMusic.vb
+1 -1
View File
@@ -266,7 +266,7 @@ Public Module ModMusic
Thread.Sleep(100)
End While
'当前音乐已播放结束，继续下一曲
If CurrentWave.PlaybackState = NAudio.Wave.PlaybackState.Stopped AndAlso MusicAllList.Count > 0 Then MusicStartPlay(DequeueNextMusicAddress)
If CurrentWave.PlaybackState = NAudio.Wave.PlaybackState.Stopped AndAlso MusicAllList.Any Then MusicStartPlay(DequeueNextMusicAddress)
Catch ex As Exception
Log("[Music] 播放音乐失败的文件完整路径：" & MusicCurrent)
If TypeOf ex Is NAudio.MmException AndAlso (ex.Message.Contains("NoDriver") OrElse ex.Message.Contains("BadDeviceId")) Then
Plain Craft Launcher 2/My Project/AssemblyInfo.vb
+5 -5
View File
@@ -8,11 +8,11 @@ Imports System.Runtime.InteropServices
'查看程序集特性的值
<Assembly: AssemblyTitle("Plain Craft Launcher 2 启动器")>
<Assembly: AssemblyTitle("Plain Craft Launcher 启动器")>
<Assembly: AssemblyDescription("Minecraft 启动器 (制作：龙腾猫跃)")>
<Assembly: AssemblyCompany("")>
<Assembly: AssemblyProduct("Plain Craft Launcher 2")>
<Assembly: AssemblyCopyright("Copyright © 龙腾猫跃 2016-2024. All Rights Reserved.")>
<Assembly: AssemblyProduct("Plain Craft Launcher")>
<Assembly: AssemblyCopyright("Copyright © 龙腾猫跃 2016. All Rights Reserved.")>
<Assembly: AssemblyConfiguration("PCL2 Config Mark")>
<Assembly: ComVisible(False)>
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值，也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.7.1.0")>
<Assembly: AssemblyFileVersion("2.7.1.0")>
<Assembly: AssemblyVersion("2.7.2.0")>
<Assembly: AssemblyFileVersion("2.7.2.0")>
<Assembly: NeutralResourcesLanguage("")>
Plain Craft Launcher 2/Pages/PageDownload/ModDownloadLib.vb
+27 -28
View File
@@ -487,7 +487,7 @@ Public Module ModDownloadLib
outputWaitHandle.WaitOne(10000)
errorWaitHandle.WaitOne(10000)
process.Dispose()
If TotalLength < 1000 Then Throw New Exception("安装器运行出错，末行为 " & LastResult)
If TotalLength < 1000 OrElse LastResult.Contains("at ") Then Throw New Exception("安装器运行出错，末行为 " & LastResult)
End Using
End Using
End SyncLock
@@ -538,7 +538,7 @@ Public Module ModDownloadLib
'OptiFine 中文镜像源
Sources.Add("https://optifine.cn/download/" & DownloadInfo.NameFile)
'构造文件请求
Task.Output = New List(Of NetFile) From {New NetFile(Sources.ToArray, Target, New FileChecker(MinSize:=64 * 1024))}
Task.Output = New List(Of NetFile) From {New NetFile(Sources.ToArray, Target, New FileChecker(MinSize:=300 * 1024))}
End Sub) With {.ProgressWeight = 8})
Loaders.Add(New LoaderDownload("下载 OptiFine 主文件", New List(Of NetFile)) With {.ProgressWeight = 8})
Loaders.Add(New LoaderTask(Of List(Of NetFile), Boolean)("等待原版下载",
@@ -548,8 +548,8 @@ Public Module ModDownloadLib
Dim TargetLoaders As List(Of LoaderBase) =
ClientDownloadLoader.GetLoaderList.Where(Function(l) l.Name = McDownloadClientLibName OrElse l.Name = McDownloadClientJsonName).
Where(Function(l) l.State <> LoadState.Finished).ToList
If TargetLoaders.Count > 0 Then Log("[Download] OptiFine 安装正在等待原版文件下载完成")
Do While TargetLoaders.Count > 0 AndAlso Not Task.IsAborted
If TargetLoaders.Any Then Log("[Download] OptiFine 安装正在等待原版文件下载完成")
Do While TargetLoaders.Any AndAlso Not Task.IsAborted
TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList
Thread.Sleep(50)
Loop
@@ -560,12 +560,10 @@ Public Module ModDownloadLib
Dim ClientName As String = GetFolderNameFromPath(ClientFolder)
Directory.CreateDirectory(McFolder & "versions\" & DownloadInfo.Inherit)
If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json") Then
CopyFile(ClientFolder & ClientName & ".json",
McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".json")
CopyFile($"{ClientFolder}{ClientName}.json", $"{McFolder}versions\{DownloadInfo.Inherit}\{DownloadInfo.Inherit}.json")
End If
If Not File.Exists(McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar") Then
CopyFile(ClientFolder & ClientName & ".jar",
McFolder & "versions\" & DownloadInfo.Inherit & "\" & DownloadInfo.Inherit & ".jar")
CopyFile($"{ClientFolder}{ClientName}.jar", $"{McFolder}versions\{DownloadInfo.Inherit}\{DownloadInfo.Inherit}.jar")
End If
End SyncLock
End Sub) With {.ProgressWeight = 0.1, .Show = False})
@@ -1283,20 +1281,20 @@ Retry:
'获取下载信息
If DownloadInfo Is Nothing Then
Loaders.Add(New LoaderTask(Of String, String)("获取 Mod 加载器详细信息",
Sub(Task As LoaderTask(Of String, String))
'获取 Forge 版本列表
Dim ForgeLoader = New LoaderTask(Of String, List(Of DlForgeVersionEntry))("McDownloadForgeLoader " & Inherit, AddressOf DlForgeVersionMain)
ForgeLoader.WaitForExit(Inherit)
Task.Progress = 0.8
'查找对应版本
For Each ForgeVersion In ForgeLoader.Output
If ForgeVersion.Version = Version Then
DownloadInfo = ForgeVersion
Exit Sub
End If
Next
Throw New Exception("未能找到 Forge " & Inherit & "-" & Version & " 的详细信息！")
End Sub) With {.ProgressWeight = 3})
Sub(Task As LoaderTask(Of String, String))
'获取 Forge 版本列表
Dim ForgeLoader = New LoaderTask(Of String, List(Of DlForgeVersionEntry))("McDownloadForgeLoader " & Inherit, AddressOf DlForgeVersionMain)
ForgeLoader.WaitForExit(Inherit)
Task.Progress = 0.8
'查找对应版本
For Each ForgeVersion In ForgeLoader.Output
If ForgeVersion.Version = Version Then
DownloadInfo = ForgeVersion
Exit Sub
End If
Next
Throw New Exception("未能找到 Forge " & Inherit & "-" & Version & " 的详细信息！")
End Sub) With {.ProgressWeight = 3})
End If
'下载 Forge 主文件
Loaders.Add(New LoaderTask(Of String, List(Of NetFile))("准备 Mod 加载器下载",
@@ -1383,8 +1381,8 @@ Retry:
Dim TargetLoaders As List(Of LoaderBase) =
ClientDownloadLoader.GetLoaderList.Where(Function(l) l.Name = McDownloadClientLibName OrElse l.Name = McDownloadClientJsonName).
Where(Function(l) l.State <> LoadState.Finished).ToList
If TargetLoaders.Count > 0 Then Log("[Download] Forge 安装正在等待原版文件下载完成")
Do While TargetLoaders.Count > 0 AndAlso Not Task.IsAborted
If TargetLoaders.Any Then Log("[Download] Forge 安装正在等待原版文件下载完成")
Do While TargetLoaders.Any AndAlso Not Task.IsAborted
TargetLoaders = TargetLoaders.Where(Function(l) l.State <> LoadState.Finished).ToList
Thread.Sleep(50)
Loop
@@ -1441,7 +1439,7 @@ Retry:
End Try
'拷贝新增的版本 Json
Dim DeltaList = New DirectoryInfo(McFolder & "versions\").EnumerateDirectories.
SkipWhile(Function(i) OldList.Contains(i.FullName)).ToList()
SkipWhile(Function(i) OldList.Contains(i.FullName)).ToList()
If DeltaList.Count > 1 Then
'它可能和 OptiFine 安装同时运行，导致增加的文件不止一个（这导致了 #151）
'也可能是因为 Forge 安装器的 Bug，生成了一个名字错误的文件夹，所以需要检查文件夹是否为空
@@ -1537,7 +1535,7 @@ Retry:
Public Sub ForgeDownloadListItemPreload(Stack As StackPanel, Entrys As List(Of DlForgeVersionEntry), OnClick As MyListItem.ClickEventHandler, IsSaveOnly As Boolean)
'获取推荐版本与最新版本
Dim FreshVersion As DlForgeVersionEntry = Nothing
If Entrys.Count > 0 Then
If Entrys.Any Then
FreshVersion = Entrys(0)
Else
Log("[System] 未找到可用的 Forge 版本", LogLevel.Debug)
@@ -2014,7 +2012,7 @@ Retry:
Dim LoaderList As New List(Of LoaderBase)
'添加忽略标识
LoaderList.Add(New LoaderTask(Of Integer, Integer)("添加忽略标识", Sub() WriteFile(OutputFolder & ".pclignore", "用于临时地 PCL 的版本列表中屏蔽此版本。")) With {.Show = False, .Block = False})
LoaderList.Add(New LoaderTask(Of Integer, Integer)("添加忽略标识", Sub() WriteFile(OutputFolder & ".pclignore", "用于临时地在 PCL 的版本列表中屏蔽此版本。")) With {.Show = False, .Block = False})
'Fabric API
If Request.FabricApi IsNot Nothing Then
LoaderList.Add(New LoaderDownload("下载 Fabric API", New List(Of NetFile) From {Request.FabricApi.ToNetFile(New McVersion(OutputFolder).GetPathIndie(True) & "mods\")}) With {.ProgressWeight = 3, .Block = False})
@@ -2164,7 +2162,7 @@ Retry:
For i = 0 To RawArguments.Count - 1
If RawArguments(i).StartsWithF("-") Then
SplitArguments.Add(RawArguments(i))
ElseIf SplitArguments.Count > 0 AndAlso SplitArguments.Last.StartsWithF("-") AndAlso Not SplitArguments.Last.Contains(" ") Then
ElseIf SplitArguments.Any AndAlso SplitArguments.Last.StartsWithF("-") AndAlso Not SplitArguments.Last.Contains(" ") Then
SplitArguments(SplitArguments.Count - 1) = SplitArguments.Last & " " & RawArguments(i)
Else
SplitArguments.Add(RawArguments(i))
@@ -2172,6 +2170,7 @@ Retry:
Next
Dim RealArguments As String = Join(SplitArguments.Distinct.ToList, " ")
'合并
'相关讨论见 #2801
OutputJson = MinecraftJson
If HasOptiFine Then
'合并 OptiFine
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadCompDetail.xaml.vb
+2 -2
View File
@@ -210,10 +210,10 @@
If Project.Type = CompType.Mod Then
'获取 Mod 所需的加载器种类
Dim AllowForge As Boolean? = Nothing, AllowFabric As Boolean? = Nothing
If File.ModLoaders.Count > 0 Then '从文件中获取
If File.ModLoaders.Any Then '从文件中获取
AllowForge = File.ModLoaders.Contains(CompModLoaderType.Forge)
AllowFabric = File.ModLoaders.Contains(CompModLoaderType.Fabric)
ElseIf Project.ModLoaders.Count > 0 Then '从工程中获取
ElseIf Project.ModLoaders.Any Then '从工程中获取
AllowForge = Project.ModLoaders.Contains(CompModLoaderType.Forge)
AllowFabric = Project.ModLoaders.Contains(CompModLoaderType.Fabric)
End If
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml
-1
View File
@@ -20,7 +20,6 @@
<StackPanel Margin="25,37,25,15">
<local:MyHint Text="你尚未选择安装 Fabric API，这会导致大多数 Mod 无法使用！" Margin="0,1,0,7" x:Name="HintFabricAPI" IsWarn="True" />
<local:MyHint Text="你尚未选择安装 OptiFabric，这会导致 OptiFine 无法使用！" Margin="0,1,0,7" x:Name="HintOptiFabric" IsWarn="True" />
<local:MyHint Text="安装结束后，请在 Mod 下载中搜索 OptiFabric Origins 并下载，否则 OptiFine 会无法使用！" Margin="0,1,0,7" x:Name="HintOptiFabricOld" IsWarn="False" />
<Grid Margin="0,0,0,11">
<Grid.ColumnDefinitions>
<ColumnDefinition Width="1*" />
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadInstall.xaml.vb
+7 -11
View File
@@ -32,7 +32,7 @@
#Region "页面切换"
'页面切换动画
Private IsInSelectPage As Boolean = False
Public IsInSelectPage As Boolean = False
Private IsFirstLoaded As Boolean = False
Private Sub EnterSelectPage()
If IsInSelectPage Then Exit Sub
@@ -273,11 +273,13 @@
End If
End Sub
Private IsReloading As Boolean = False '#3742 中，LoadOptiFineGetError 会初始化 LoadOptiFine，触发事件 LoadOptiFine.StateChanged，导致再次调用 SelectReload
''' <summary>
''' 重载已选择的项目的显示。
''' </summary>
Private Sub SelectReload() Handles CardOptiFine.Swap, LoadOptiFine.StateChanged, CardForge.Swap, LoadForge.StateChanged, CardFabric.Swap, LoadFabric.StateChanged, CardFabricApi.Swap, LoadFabricApi.StateChanged, CardOptiFabric.Swap, LoadOptiFabric.StateChanged, CardLiteLoader.Swap, LoadLiteLoader.StateChanged
If SelectedMinecraftId Is Nothing Then Exit Sub
If SelectedMinecraftId Is Nothing OrElse IsReloading Then Exit Sub
IsReloading = True
'主预览
SelectNameUpdate()
ItemSelect.Title = TextSelectName.Text
@@ -385,17 +387,12 @@
'主警告
HintFabricAPI.Visibility = If(SelectedFabric IsNot Nothing AndAlso SelectedFabricApi Is Nothing, Visibility.Visible, Visibility.Collapsed)
If SelectedFabric IsNot Nothing AndAlso SelectedOptiFine IsNot Nothing AndAlso SelectedOptiFabric Is Nothing Then
If SelectedMinecraftId.StartsWith("1.14") OrElse SelectedMinecraftId.StartsWith("1.15") Then
HintOptiFabric.Visibility = Visibility.Collapsed
HintOptiFabricOld.Visibility = Visibility.Visible
Else
HintOptiFabric.Visibility = Visibility.Visible
HintOptiFabricOld.Visibility = Visibility.Collapsed
End If
HintOptiFabric.Visibility = Visibility.Visible
Else
HintOptiFabric.Visibility = Visibility.Collapsed
HintOptiFabricOld.Visibility = Visibility.Collapsed
End If
'结束
IsReloading = False
End Sub
''' <summary>
''' 清空已选择的项目。
@@ -1037,7 +1034,6 @@
''' 获取 OptiFabric 的加载异常信息。若正常则返回 Nothing。
''' </summary>
Private Function LoadOptiFabricGetError() As String
If SelectedMinecraftId.StartsWith("1.14") OrElse SelectedMinecraftId.StartsWith("1.15") Then Return "不兼容老版本 Fabric，请手动下载 OptiFabric Origins"
If LoadOptiFabric Is Nothing OrElse LoadOptiFabric.State.LoadingState = MyLoading.MyLoadingState.Run Then Return "正在获取版本列表……"
If LoadOptiFabric.State.LoadingState = MyLoading.MyLoadingState.Error Then Return "获取版本列表失败：" & CType(LoadOptiFabric.State, Object).Error.Message
If DlOptiFabricLoader.Output Is Nothing Then
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadMod.xaml
+1 -4
View File
@@ -35,7 +35,6 @@
<local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" />
<local:MyComboBoxItem Content="1.20.6" />
<local:MyComboBoxItem Content="1.20.4" />
<local:MyComboBoxItem Content="1.20.2" />
<local:MyComboBoxItem Content="1.20.1" />
<local:MyComboBoxItem Content="1.19.4" />
<local:MyComboBoxItem Content="1.19.2" />
@@ -44,11 +43,9 @@
<local:MyComboBoxItem Content="1.16.5" />
<local:MyComboBoxItem Content="1.15.2" />
<local:MyComboBoxItem Content="1.14.4" />
<local:MyComboBoxItem Content="1.13.2" />
<local:MyComboBoxItem Content="1.12.2" />
<local:MyComboBoxItem Content="1.11.2" />
<local:MyComboBoxItem Content="1.10.2" />
<local:MyComboBoxItem Content="1.9.4" />
<local:MyComboBoxItem Content="1.8.9" />
<local:MyComboBoxItem Content="1.7.10" />
</local:MyComboBox>
@@ -122,4 +119,4 @@
</local:MyCard>
</StackPanel>
</local:MyScrollViewer>
</local:MyPageRight>
</local:MyPageRight>
Plain Craft Launcher 2/Pages/PageDownload/PageDownloadPack.xaml
+1 -4
View File
@@ -34,7 +34,6 @@
<local:MyComboBoxItem Content="全部 (也可自行输入)" IsSelected="True" />
<local:MyComboBoxItem Content="1.20.6" />
<local:MyComboBoxItem Content="1.20.4" />
<local:MyComboBoxItem Content="1.20.2" />
<local:MyComboBoxItem Content="1.20.1" />
<local:MyComboBoxItem Content="1.19.4" />
<local:MyComboBoxItem Content="1.19.2" />
@@ -43,11 +42,9 @@
<local:MyComboBoxItem Content="1.16.5" />
<local:MyComboBoxItem Content="1.15.2" />
<local:MyComboBoxItem Content="1.14.4" />
<local:MyComboBoxItem Content="1.13.2" />
<local:MyComboBoxItem Content="1.12.2" />
<local:MyComboBoxItem Content="1.11.2" />
<local:MyComboBoxItem Content="1.10.2" />
<local:MyComboBoxItem Content="1.9.4" />
<local:MyComboBoxItem Content="1.8.9" />
<local:MyComboBoxItem Content="1.7.10" />
</local:MyComboBox>
@@ -111,4 +108,4 @@
</local:MyCard>
</StackPanel>
</local:MyScrollViewer>
</local:MyPageRight>
</local:MyPageRight>
Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchLeft.xaml.vb
+47 -45
View File
@@ -19,51 +19,53 @@
RefreshButtonsUI()
'加载版本
RunInNewThread(Sub()
'确认 Minecraft 文件夹存在
PathMcFolder = Setup.Get("LaunchFolderSelect").ToString.Replace("$", Path)
If PathMcFolder = "" OrElse Not Directory.Exists(PathMcFolder) Then
'无效的文件夹
If PathMcFolder = "" Then
Log("[Launch] 没有已储存的 Minecraft 文件夹")
Else
Log("[Launch] Minecraft 文件夹无效，该文件夹已不存在：" & PathMcFolder, LogLevel.Debug)
End If
McFolderListLoader.WaitForExit(IsForceRestart:=True)
Setup.Set("LaunchFolderSelect", McFolderList(0).Path.Replace(Path, "$"))
End If
Log("[Launch] Minecraft 文件夹：" & PathMcFolder)
If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(500, 3000))
'确认 Minecraft 版本存在
Dim Selection As String = Setup.Get("LaunchVersionSelect")
Dim Version As McVersion
If Selection = "" Then
Version = Nothing
Else
Version = New McVersion(Selection)
End If
If IsNothing(Version) OrElse Not (Version.Path.StartsWith(PathMcFolder) AndAlso Version.Check) Then
'无效的版本
Log("[Launch] Minecraft 版本无效" & If(IsNothing(Version), "，没有有效版本", "：" & Version.Path), If(IsNothing(Version), LogLevel.Normal, LogLevel.Debug))
If Not McVersionListLoader.State = LoadState.Finished Then LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True)
If Not McVersionList.Any() OrElse McVersionList.First.Value(0).Logo.Contains("RedstoneBlock") Then
Version = Nothing
Setup.Set("LaunchVersionSelect", "")
Log("[Launch] 无可用 Minecraft 版本")
Else
Version = McVersionList.First.Value(0)
Setup.Set("LaunchVersionSelect", Version.Name)
Log("[Launch] 自动选择 Minecraft 版本：" & Version.Path)
End If
End If
RunInUi(Sub()
McVersionCurrent = Version '绕这一圈是为了避免 McVersionCheck 触发第二次版本改变
IsLoadFinished = True
RefreshButtonsUI()
RefreshPage(False, False) '有可能选择的版本变化了，需要重新刷新
If McLoginAble() = "" Then McLoginLoader.Start() '自动登录
End Sub)
End Sub, "Version Check", ThreadPriority.AboveNormal)
RunInNewThread(
Sub()
'确认 Minecraft 文件夹存在
PathMcFolder = Setup.Get("LaunchFolderSelect").ToString.Replace("$", Path)
If PathMcFolder = "" OrElse Not Directory.Exists(PathMcFolder) Then
'无效的文件夹
If PathMcFolder = "" Then
Log("[Launch] 没有已储存的 Minecraft 文件夹")
Else
Log("[Launch] Minecraft 文件夹无效，该文件夹已不存在：" & PathMcFolder, LogLevel.Debug)
End If
McFolderListLoader.WaitForExit(IsForceRestart:=True)
Setup.Set("LaunchFolderSelect", McFolderList(0).Path.Replace(Path, "$"))
End If
Log("[Launch] Minecraft 文件夹：" & PathMcFolder)
If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(500, 3000))
'确认 Minecraft 版本存在
Dim Selection As String = Setup.Get("LaunchVersionSelect")
Dim Version As McVersion
If Selection = "" Then
Version = Nothing
Else
Version = New McVersion(Selection)
End If
If IsNothing(Version) OrElse Not (Version.Path.StartsWith(PathMcFolder) AndAlso Version.Check) Then
'无效的版本
Log("[Launch] Minecraft 版本无效" & If(IsNothing(Version), "，没有有效版本", "：" & Version.Path), If(IsNothing(Version), LogLevel.Normal, LogLevel.Debug))
If Not McVersionListLoader.State = LoadState.Finished Then LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.ForceRun, MaxDepth:=1, ExtraPath:="versions\", WaitForExit:=True)
If Not McVersionList.Any() OrElse McVersionList.First.Value(0).Logo.Contains("RedstoneBlock") Then
Version = Nothing
Setup.Set("LaunchVersionSelect", "")
Log("[Launch] 无可用 Minecraft 版本")
Else
Version = McVersionList.First.Value(0)
Setup.Set("LaunchVersionSelect", Version.Name)
Log("[Launch] 自动选择 Minecraft 版本：" & Version.Path)
End If
End If
RunInUi(
Sub()
McVersionCurrent = Version '绕这一圈是为了避免 McVersionCheck 触发第二次版本改变
IsLoadFinished = True
RefreshButtonsUI()
RefreshPage(False, False) '有可能选择的版本变化了，需要重新刷新
If McLoginAble() = "" Then McLoginLoader.Start() '自动登录
End Sub)
End Sub, "Version Check", ThreadPriority.AboveNormal)
'改变页面
Dim LoginType As McLoginType = Setup.Get("LoginType")
Plain Craft Launcher 2/Pages/PageLaunch/PageLaunchRight.xaml.vb
+7 -7
View File
@@ -67,7 +67,7 @@ Download:
End If
Case 3
Select Case Setup.Get("UiCustomPreset")
Case 0 '你知道吗
Case 0
Log("[Page] 主页预设：你知道吗")
Content = "
<local:MyCard Title=""你知道吗？"" Margin=""0,0,0,15"">
@@ -76,7 +76,7 @@ Download:
EventType=""刷新主页"" EventData=""/""
Logo=""M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z"" />
</local:MyCard>"
Case 1 '回声洞
Case 1
Log("[Page] 主页预设：回声洞")
Content = "
<local:MyCard Title=""回声洞"" Margin=""0,0,0,15"">
@@ -85,17 +85,17 @@ Download:
EventType=""刷新主页"" EventData=""/""
Logo=""M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z"" />
</local:MyCard>"
Case 2 '新闻
Case 2
Log("[Page] 主页预设：Minecraft 新闻")
Url = "http://pcl.mcnews.thestack.top"
GoTo Download
Case 3 '简单主页
Case 3
Log("[Page] 主页预设：简单主页")
Url = "https://gitee.com/mfn233/PCL-Mainpage/raw/main/Custom.xaml"
GoTo Download
Case 4 '历史上的今天
Log("[Page] 主页预设：历史上的今天")
Url = "https://pclnews.52chye.cn/custom.xaml"
Case 4
Log("[Page] 主页预设：每日整合包推荐")
Url = "https://pclsub.sodamc.com/"
GoTo Download
End Select
End Select
Plain Craft Launcher 2/Pages/PageLaunch/PageLoginMsSkin.xaml.vb
+43 -42
View File
@@ -85,50 +85,51 @@
Hint("正在更改皮肤……")
IsChanging = True
'开始实际获取
RunInNewThread(Async Sub()
Try
RunInNewThread(
Async Sub()
Try
Retry:
If McLoginMsLoader.State = LoadState.Loading Then McLoginMsLoader.WaitForExit() '等待登录结束
Dim AccessToken As String = Setup.Get("CacheMsAccess")
Dim Uuid As String = Setup.Get("CacheMsUuid")
If McLoginMsLoader.State = LoadState.Loading Then McLoginMsLoader.WaitForExit() '等待登录结束
Dim AccessToken As String = Setup.Get("CacheMsAccess")
Dim Uuid As String = Setup.Get("CacheMsUuid")
Dim Client As New Net.Http.HttpClient With {.Timeout = New TimeSpan(0, 0, 30)}
Client.DefaultRequestHeaders.Authorization = New Net.Http.Headers.AuthenticationHeaderValue("Bearer", AccessToken)
Client.DefaultRequestHeaders.Accept.Add(New Net.Http.Headers.MediaTypeWithQualityHeaderValue("*/*"))
Client.DefaultRequestHeaders.UserAgent.Add(New Net.Http.Headers.ProductInfoHeaderValue("MojangSharp", "0.1"))
Dim Contents As New Net.Http.MultipartFormDataContent From {
{New Net.Http.StringContent(If(SkinInfo.IsSlim, "slim", "classic")), "variant"},
{New Net.Http.ByteArrayContent(File.ReadAllBytes(SkinInfo.LocalFile)), "file", GetFileNameFromPath(SkinInfo.LocalFile)}
}
Dim Result As String = Await (Await Client.PostAsync(New Uri("https://api.minecraftservices.com/minecraft/profile/skins"), Contents)).Content.ReadAsStringAsync
If Result.Contains("request requires user authentication") Then
Hint("正在登录，将在登录完成后继续更改皮肤……")
McLoginMsLoader.Start(GetLoginData(), IsForceRestart:=True)
GoTo Retry
ElseIf Result.Contains("""error""") Then
Hint("更改皮肤失败：" & GetJson(Result)("error"), HintType.Critical)
Exit Sub
End If
'获取新皮肤地址
Log("[Skin] 皮肤修改返回值：" & vbCrLf & Result)
Dim ResultJson As JObject = GetJson(Result)
For Each Skin As JObject In ResultJson("skins")
If Skin("state").ToString = "ACTIVE" Then
MySkin.ReloadCache(Skin("url"))
Exit Sub
End If
Next
Throw New Exception("未知错误（" & Result & "）")
Catch ex As Exception
If ex.GetType.Equals(GetType(Tasks.TaskCanceledException)) Then
Hint("更改皮肤失败：与 Mojang 皮肤服务器的连接超时，请检查你的网络是否通畅！", HintType.Critical)
Else
Log(ex, "更改皮肤失败", LogLevel.Hint)
End If
Finally
IsChanging = False
End Try
End Sub, "Ms Skin Upload")
Dim Client As New Net.Http.HttpClient With {.Timeout = New TimeSpan(0, 0, 30)}
Client.DefaultRequestHeaders.Authorization = New Net.Http.Headers.AuthenticationHeaderValue("Bearer", AccessToken)
Client.DefaultRequestHeaders.Accept.Add(New Net.Http.Headers.MediaTypeWithQualityHeaderValue("*/*"))
Client.DefaultRequestHeaders.UserAgent.Add(New Net.Http.Headers.ProductInfoHeaderValue("MojangSharp", "0.1"))
Dim Contents As New Net.Http.MultipartFormDataContent From {
{New Net.Http.StringContent(If(SkinInfo.IsSlim, "slim", "classic")), "variant"},
{New Net.Http.ByteArrayContent(File.ReadAllBytes(SkinInfo.LocalFile)), "file", GetFileNameFromPath(SkinInfo.LocalFile)}
}
Dim Result As String = Await (Await Client.PostAsync(New Uri("https://api.minecraftservices.com/minecraft/profile/skins"), Contents)).Content.ReadAsStringAsync
If Result.Contains("request requires user authentication") Then
Hint("正在登录，将在登录完成后继续更改皮肤……")
McLoginMsLoader.Start(GetLoginData(), IsForceRestart:=True)
GoTo Retry
ElseIf Result.Contains("""error""") Then
Hint("更改皮肤失败：" & GetJson(Result)("error"), HintType.Critical)
Exit Sub
End If
'获取新皮肤地址
Log("[Skin] 皮肤修改返回值：" & vbCrLf & Result)
Dim ResultJson As JObject = GetJson(Result)
For Each Skin As JObject In ResultJson("skins")
If Skin("state").ToString = "ACTIVE" Then
MySkin.ReloadCache(Skin("url"))
Exit Sub
End If
Next
Throw New Exception("未知错误（" & Result & "）")
Catch ex As Exception
If ex.GetType.Equals(GetType(Tasks.TaskCanceledException)) Then
Hint("更改皮肤失败：与 Mojang 皮肤服务器的连接超时，请检查你的网络是否通畅！", HintType.Critical)
Else
Log(ex, "更改皮肤失败", LogLevel.Hint)
End If
Finally
IsChanging = False
End Try
End Sub, "Ms Skin Upload")
End Sub
'保存皮肤
Plain Craft Launcher 2/Pages/PageSelectLeft.xaml.vb
+1 -1
View File
@@ -237,7 +237,7 @@
If Not Version.Modable Then Continue For
'4. 该版本的隔离文件夹下不存在 mods
Dim ModIndieFolder As New DirectoryInfo(Version.Path & "mods\")
If ModIndieFolder.Exists AndAlso ModIndieFolder.EnumerateFiles.Count > 0 Then Exit Sub
If ModIndieFolder.Exists AndAlso ModIndieFolder.EnumerateFiles.Any Then Exit Sub
'满足以上全部条件则视为根目录整合包
Setup.Set("VersionArgumentIndie", 2, Version:=Version)
Log("[Setup] 已自动关闭单版本隔离：" & Version.Name, LogLevel.Debug)
Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml
+11 -7
View File
@@ -115,7 +115,7 @@
<local:MyComboBoxItem Content="中（平衡）" IsSelected="True" />
<local:MyComboBoxItem Content="低（优先保证其他程序运行，但可能让游戏卡顿，适合挂机时使用）" />
</local:MyComboBox>
<TextBlock VerticalAlignment="Center" Grid.Row="10" HorizontalAlignment="Left" Text="游戏窗口" Margin="0,0,25,0" />
<TextBlock VerticalAlignment="Center" Grid.Row="10" HorizontalAlignment="Left" Text="窗口大小" Margin="0,0,25,0" />
<Grid x:Name="PanArgumentWindow" Grid.Row="10" Grid.ColumnSpan="2" Grid.Column="1">
<Grid.ColumnDefinitions>
<ColumnDefinition />
@@ -125,11 +125,10 @@
</Grid.ColumnDefinitions>
<local:MyComboBox x:Name="ComboArgumentWindowType" Tag="LaunchArgumentWindowType">
<local:MyComboBoxItem Content="全屏" />
<local:MyComboBoxItem Content="默认大小" IsSelected="True" ToolTip="以 854×480 的默认窗口大小启动 Minecraft" />
<local:MyComboBoxItem Content="与启动器窗口大小一致" />
<local:MyComboBoxItem Content="自定义大小" ToolTip="注意：Forge 1.12 存在 Bug，会导致高度设定无效" />
<local:MyComboBoxItem Content="默认" IsSelected="True" />
<local:MyComboBoxItem Content="与启动器尺寸一致" />
<local:MyComboBoxItem Content="自定义尺寸" ToolTip="Forge 1.12.2 等个别版本存在 Bug，会导致高度设定无效" />
<local:MyComboBoxItem Content="最大化" />
<local:MyComboBoxItem Content="保持游戏默认" />
</local:MyComboBox>
<local:MyTextBox Padding="0,0,5,0" Visibility="Collapsed" Grid.Column="1" Margin="50,0,0,0" x:Name="TextArgumentWindowWidth" Tag="LaunchArgumentWindowWidth" Width="60" HorizontalContentAlignment="Center" Text="854">
<local:MyTextBox.ValidateRules>
@@ -138,7 +137,7 @@
</local:MyTextBox>
<TextBlock x:Name="LabArgumentWindowMiddle" Visibility="Collapsed" Grid.Column="2" Text=" × " VerticalAlignment="Center" FontSize="18" />
<local:MyTextBox Padding="0,0,5,0" Visibility="Collapsed" Grid.Column="3" Width="60" HorizontalContentAlignment="Center" x:Name="TextArgumentWindowHeight" Tag="LaunchArgumentWindowHeight" Text="480"
ToolTip="注意：Forge 1.12.2 等个别版本存在 Bug，会导致高度设定无效" ToolTipService.Placement="Right" ToolTipService.HorizontalOffset="5">
ToolTip="Forge 1.12.2 等个别版本存在 Bug，会导致高度设定无效" ToolTipService.Placement="Right" ToolTipService.HorizontalOffset="5">
<local:MyTextBox.ValidateRules>
<local:ValidateInteger Min="1" Max="9999" />
</local:MyTextBox.ValidateRules>
@@ -175,11 +174,16 @@
<RowDefinition Height="Auto" />
<RowDefinition Height="9" />
<RowDefinition Height="Auto" />
<RowDefinition Height="9" />
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<local:MyRadioBox Text="自动配置" Width="110" Checked="True" x:Name="RadioRamType0" Tag="LaunchRamType/0" Margin="0,0,20,0"
ToolTip="根据安装的 Mod 量与电脑剩余内存，动态调整为游戏分配的内存" ToolTipService.Placement="Right" ToolTipService.HorizontalOffset="-10" ToolTipService.VerticalOffset="-3" />
<local:MyRadioBox Grid.Row="2" Text="自定义" x:Name="RadioRamType1" Tag="LaunchRamType/1" Margin="0,0,20,0" />
<local:MySlider Grid.Row="2" Grid.Column="1" IsEnabled="False" x:Name="SliderRamCustom" Tag="LaunchRamCustom" MaxValue="49" Value="13" />
<local:MyCheckBox Grid.Row="4" Grid.ColumnSpan="3" Text="启动游戏前进行内存优化" Height="22" x:Name="CheckArgumentRam" Tag="LaunchArgumentRam"
ToolTipService.Placement="Left" ToolTipService.HorizontalOffset="525" ToolTipService.VerticalOffset="-30"
ToolTip="内存优化能将当前物理内存占用降低约 1/3，不仅限于 MC！&#xa;如果使用机械硬盘，这还可能会导致一小段时间的严重卡顿。&#xa;使用 --memory 参数启动 PCL 可以静默执行内存优化。" />
<!--<local:MyTextBox Grid.Row="2" Grid.Column="3" Width="100" VerticalAlignment="Center" Margin="30,0,0,0" Text="2048 MB" />-->
</Grid>
<Grid x:Name="PanRamDisplay" Margin="0,11,2,0" SnapsToDevicePixels="True" Grid.Row="1" Grid.ColumnSpan="2" Grid.Column="1">
@@ -229,7 +233,7 @@
<RowDefinition Height="Auto" />
</Grid.RowDefinitions>
<TextBlock Grid.Row="0" VerticalAlignment="Center" HorizontalAlignment="Left" Text="JVM 参数头" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextAdvanceJvm" Grid.Row="0" Grid.ColumnSpan="2" Tag="LaunchAdvanceJvm" Grid.Column="1" ToolTip="启动 Minecraft 时使用的额外 JVM 参数，在没有确定把握的情况下请不要尝试修改。&#xa;你可以通过点击左侧选项卡的初始化按钮来恢复到默认设置。" MaxLength="4000" Text="-XX:+UseG1GC -XX:-UseAdaptiveSizePolicy -XX:-OmitStackTraceInFastThrow -Dfml.ignoreInvalidMinecraftCertificates=True -Dfml.ignorePatchDiscrepancies=True -Dlog4j2.formatMsgNoLookups=true"
<local:MyTextBox x:Name="TextAdvanceJvm" Grid.Row="0" Grid.ColumnSpan="2" Tag="LaunchAdvanceJvm" Grid.Column="1" ToolTip="启动 Minecraft 时使用的额外 JVM 参数，在没有确定把握的情况下请不要尝试修改。&#xa;你可以通过点击左侧选项卡的初始化按钮来恢复到默认设置。" MaxLength="4000"
Height="57" AcceptsReturn="True" TextWrapping="Wrap" VerticalContentAlignment="Top" Padding="0,5" />
<TextBlock Grid.Row="2" VerticalAlignment="Center" HorizontalAlignment="Left" Text="JVM 参数尾" Margin="0,0,25,0" />
<local:MyTextBox x:Name="TextAdvanceGame" Grid.Row="2" Grid.ColumnSpan="2" Tag="LaunchAdvanceGame" Grid.Column="1" ToolTip="文本框中的内容将会被直接拼合在启动参数的末尾。&#xa;例如输入 --demo 则会以试玩模式启动游戏。" />
Plain Craft Launcher 2/Pages/PageSetup/PageSetupLaunch.xaml.vb
+46 -35
View File
@@ -38,6 +38,7 @@
ComboArgumentWindowType.SelectedIndex = Setup.Get("LaunchArgumentWindowType")
TextArgumentWindowWidth.Text = Setup.Get("LaunchArgumentWindowWidth")
TextArgumentWindowHeight.Text = Setup.Get("LaunchArgumentWindowHeight")
CheckArgumentRam.Checked = Setup.Get("LaunchArgumentRam")
RefreshJavaComboBox()
'游戏内存
@@ -71,6 +72,7 @@
Setup.Reset("LaunchArgumentWindowWidth")
Setup.Reset("LaunchArgumentWindowHeight")
Setup.Reset("LaunchArgumentPriority")
Setup.Reset("LaunchArgumentRam")
Setup.Reset("LaunchRamType")
Setup.Reset("LaunchRamCustom")
Setup.Reset("LaunchSkinType")
@@ -108,7 +110,7 @@
Private Shared Sub ComboChange(sender As MyComboBox, e As Object) Handles ComboArgumentIndie.SelectionChanged, ComboArgumentVisibie.SelectionChanged, ComboArgumentWindowType.SelectionChanged, ComboArgumentPriority.SelectionChanged
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.SelectedIndex)
End Sub
Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckAdvanceAssets.Change, CheckAdvanceJava.Change, CheckAdvanceRunWait.Change
Private Shared Sub CheckBoxChange(sender As MyCheckBox, e As Object) Handles CheckAdvanceAssets.Change, CheckAdvanceJava.Change, CheckAdvanceRunWait.Change, CheckArgumentRam.Change
If AniControlEnabled = 0 Then Setup.Set(sender.Tag, sender.Checked)
End Sub
@@ -352,19 +354,19 @@
'可安装 Mod 的版本
Dim ModDir As New DirectoryInfo(Version.PathIndie & "mods\")
Dim ModCount As Integer = If(ModDir.Exists, ModDir.GetFiles.Length, 0)
RamMininum = 0.4 + ModCount / 150
RamTarget1 = 1.5 + ModCount / 100
RamTarget2 = 3 + ModCount / 60
RamTarget3 = 6 + ModCount / 30
RamMininum = 0.5 + ModCount / 150
RamTarget1 = 1.5 + ModCount / 90
RamTarget2 = 2.7 + ModCount / 50
RamTarget3 = 4.5 + ModCount / 25
ElseIf Version IsNot Nothing AndAlso Version.Version.HasOptiFine Then
'OptiFine 版本
RamMininum = 0.3
RamMininum = 0.5
RamTarget1 = 1.5
RamTarget2 = 3
RamTarget3 = 6
RamTarget3 = 5
Else
'普通版本
RamMininum = 0.3
RamMininum = 0.5
RamTarget1 = 1.5
RamTarget2 = 2.5
RamTarget3 = 4
@@ -372,27 +374,23 @@
Dim RamDelta As Double
'预分配内存，阶段一，0 ~ T1，100%
RamDelta = RamTarget1
RamAvailable = Math.Max(0, RamAvailable - 0.1)
RamGive += Math.Min(RamAvailable * 1, RamDelta)
RamAvailable -= RamDelta / 1 + 0.1
RamGive += Math.Min(RamAvailable, RamDelta)
RamAvailable -= RamDelta
If RamAvailable < 0.1 Then GoTo PreFin
'预分配内存，阶段二，T1 ~ T2，80%
'预分配内存，阶段二，T1 ~ T2，70%
RamDelta = RamTarget2 - RamTarget1
RamAvailable = Math.Max(0, RamAvailable - 0.1)
RamGive += Math.Min(RamAvailable * 0.8, RamDelta)
RamAvailable -= RamDelta / 0.8 + 0.1
RamGive += Math.Min(RamAvailable * 0.7, RamDelta)
RamAvailable -= RamDelta / 0.7
If RamAvailable < 0.1 Then GoTo PreFin
'预分配内存，阶段三，T2 ~ T3，60%
'预分配内存，阶段三，T2 ~ T3，40%
RamDelta = RamTarget3 - RamTarget2
RamAvailable = Math.Max(0, RamAvailable - 0.2)
RamGive += Math.Min(RamAvailable * 0.6, RamDelta)
RamAvailable -= RamDelta / 0.6 + 0.2
If RamAvailable < 0.1 Then GoTo PreFin
'预分配内存，阶段四，T3 ~ T3 * 2，40%
RamDelta = RamTarget3
RamAvailable = Math.Max(0, RamAvailable - 0.3)
RamGive += Math.Min(RamAvailable * 0.4, RamDelta)
RamAvailable -= RamDelta / 0.4 + 0.3
RamAvailable -= RamDelta / 0.4
If RamAvailable < 0.1 Then GoTo PreFin
'预分配内存，阶段四，T3 ~ T3 * 2，15%
RamDelta = RamTarget3
RamGive += Math.Min(RamAvailable * 0.15, RamDelta)
RamAvailable -= RamDelta / 0.15
If RamAvailable < 0.1 Then GoTo PreFin
PreFin:
'不低于最低值
@@ -444,7 +442,7 @@ PreFin:
Log(ex, "更新设置 Java 下拉框失败", LogLevel.Feedback)
End Try
'更新选择项
If SelectedItem Is Nothing AndAlso JavaList.Count > 0 Then SelectedItem = ComboArgumentJava.Items(0) '选中 “自动选择”
If SelectedItem Is Nothing AndAlso JavaList.Any Then SelectedItem = ComboArgumentJava.Items(0) '选中 “自动选择”
ComboArgumentJava.SelectedItem = SelectedItem
'结束处理
If SelectedItem Is Nothing Then
@@ -515,15 +513,16 @@ PreFin:
Hint("正在搜索 Java，请稍候！", HintType.Critical)
Exit Sub
End If
RunInThread(Sub()
Hint("正在搜索 Java！")
JavaSearchLoader.WaitForExit(IsForceRestart:=True)
If Not JavaList.Any() Then
Hint("未找到可用的 Java！", HintType.Critical)
Else
Hint("已找到 " & JavaList.Count & " 个 Java，请检查下拉框查看列表！", HintType.Finish)
End If
End Sub)
RunInThread(
Sub()
Hint("正在搜索 Java！")
JavaSearchLoader.WaitForExit(IsForceRestart:=True)
If Not JavaList.Any() Then
Hint("未找到可用的 Java！", HintType.Critical)
Else
Hint("已找到 " & JavaList.Count & " 个 Java，请检查下拉框查看列表！", HintType.Finish)
End If
End Sub)
End Sub
#End Region
@@ -548,12 +547,24 @@ PreFin:
If AniControlEnabled <> 0 Then Exit Sub
If ComboArgumentVisibie.SelectedIndex = 0 Then
If MyMsgBox("若在游戏启动后立即关闭启动器，崩溃检测、更改游戏标题等功能将失效。" & vbCrLf &
"如果想保留这些功能，可以选择让启动器在游戏启动后隐藏，游戏退出后自动关闭。", "提示", "继续", "取消") = 2 Then
"如果想保留这些功能，可以选择让启动器在游戏启动后隐藏，游戏退出后自动关闭。", "提醒", "继续", "取消") = 2 Then
ComboArgumentVisibie.SelectedItem = e.RemovedItems(0)
End If
End If
End Sub
'开启自动内存优化的警告
Private Sub CheckArgumentRam_Change() Handles CheckArgumentRam.Change
If AniControlEnabled <> 0 Then Exit Sub
If Not CheckArgumentRam.Checked Then Return
If MyMsgBox("内存优化耗时较长，这会拖慢游戏的启动过程，建议仅在电脑内存不充裕时开启此选项。" & vbCrLf &
"如果你在使用机械硬盘，这还可能会导致一小段时间的严重卡顿。" &
If(IsAdmin(), "", $"{vbCrLf}{vbCrLf}每次启动游戏，PCL 都需要申请管理员权限以进行内存优化。{vbCrLf}若想自动授予权限，可以右键 PCL，打开 属性 → 兼容性 → 以管理员身份运行此程序。"),
"提醒", "确定", "取消") = 2 Then
CheckArgumentRam.Checked = False
End If
End Sub
#End Region
#Region "高级设置"
Plain Craft Launcher 2/Pages/PageSetup/PageSetupSystem.xaml.vb
+15 -17
View File
@@ -126,23 +126,21 @@
'滑动条
Private Sub SliderLoad()
SliderDownloadThread.GetHintText = Function(Value As Integer)
Return Value + 1
End Function
SliderDownloadSpeed.GetHintText = Function(Value As Integer)
If Value <= 14 Then
Return (Value + 1) * 0.1 & " M/s"
ElseIf Value <= 31 Then
Return (Value - 11) * 0.5 & " M/s"
ElseIf Value <= 41 Then
Return (Value - 21) & " M/s"
Else
Return "无限制"
End If
End Function
SliderDebugAnim.GetHintText = Function(Value As Integer)
Return If(Value > 29, "关闭", (Value / 10 + 0.1) & "x")
End Function
SliderDownloadThread.GetHintText = Function(v) v + 1
SliderDownloadSpeed.GetHintText =
Function(v)
Select Case v
Case Is <= 14
Return (v + 1) * 0.1 & " M/s"
Case Is <= 31
Return (v - 11) * 0.5 & " M/s"
Case Is <= 41
Return (v - 21) & " M/s"
Case Else
Return "无限制"
End Select
End Function
SliderDebugAnim.GetHintText = Function(v) If(v > 29, "关闭", (v / 10 + 0.1) & "x")
End Sub
Private Sub SliderDownloadThread_PreviewChange(sender As Object, e As RouteEventArgs) Handles SliderDownloadThread.PreviewChange
If SliderDownloadThread.Value < 100 Then Exit Sub
Plain Craft Launcher 2/Pages/PageVersion/PageVersionMod.xaml.vb
+3 -3
View File
@@ -177,7 +177,7 @@
Private Sub BtnManageCheck_Click(sender As Object, e As EventArgs) Handles BtnManageCheck.Click
Try
Dim Result = McModCheck(PageVersionLeft.Version, McModLoader.Output)
If Result.Count > 0 Then
If Result.Any Then
MyMsgBox(Join(Result, vbCrLf & vbCrLf), "Mod 检查结果")
Else
Hint("Mod 检查完成，未发现任何问题！", HintType.Finish)
@@ -620,13 +620,13 @@
If ModEntry.ModId IsNot Nothing Then
DebugInfo.Add("Mod ID：" & ModEntry.ModId)
End If
If ModEntry.Dependencies.Count > 0 Then
If ModEntry.Dependencies.Any Then
DebugInfo.Add("依赖于：")
For Each Dep In ModEntry.Dependencies
DebugInfo.Add(" - " & Dep.Key & If(Dep.Value Is Nothing, "", "，版本：" & Dep.Value))
Next
End If
If DebugInfo.Count > 0 Then
If DebugInfo.Any Then
ContentLines.Add("")
ContentLines.AddRange(DebugInfo)
End If
Plain Craft Launcher 2/Pages/PageVersion/PageVersionSetup.xaml.vb
+2 -2
View File
@@ -33,7 +33,7 @@
If Indie = -1 Then
Dim ModFolder As New DirectoryInfo(PageVersionLeft.Version.Path & "mods\")
Dim SaveFolder As New DirectoryInfo(PageVersionLeft.Version.Path & "saves\")
If (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Count > 0) OrElse (SaveFolder.Exists AndAlso SaveFolder.EnumerateFiles.Count > 0) Then
If (ModFolder.Exists AndAlso ModFolder.EnumerateFiles.Any) OrElse (SaveFolder.Exists AndAlso SaveFolder.EnumerateFiles.Any) Then
'自动开启
Setup.Set("VersionArgumentIndie", 1, Version:=PageVersionLeft.Version)
Log("[Setup] 已自动开启单版本隔离：" & PageVersionLeft.Version.Name)
@@ -438,7 +438,7 @@ PreFin:
Log(ex, "更新版本设置 Java 下拉框失败", LogLevel.Feedback)
End Try
'更新选择项
If SelectedItem Is Nothing AndAlso JavaList.Count > 0 Then
If SelectedItem Is Nothing AndAlso JavaList.Any Then
If SelectedBySetup = "" Then
SelectedItem = ComboArgumentJava.Items(1) '选中 “自动选择”
Else
Plain Craft Launcher 2/Resources/Help.zip
BIN
View File
Binary file not shown.
Plain Craft Launcher 2/app.manifest
+3 -3
View File
@@ -29,8 +29,8 @@
<!-- Windows Vista -->
<!--<supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}" />-->
<!-- Windows 7 -->
<supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}" />
<!-- Windows 7 --><!--
<supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}" />-->
<!-- Windows 8 -->
<!--<supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}" />-->
@@ -38,7 +38,7 @@
<!-- Windows 8.1 -->
<!--<supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}" />-->
<!-- Windows 10 -->
<!-- Windows 10+ -->
<supportedOS Id="{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}" />
</application>