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

2.13.0.0

Browse Source
This commit is contained in:
龙腾猫跃
2026-07-02 23:24:29 +08:00
parent 124e3be6bf
commit c6d0457946
193 changed files with 3112 additions and 3747 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb
+2 -2
View File
@@ -1,4 +1,4 @@
Public Class CrashAnalyzer
Public Class CrashAnalyzer
'构造函数
Private TempFolder As String
@@ -24,7 +24,7 @@
'简单收集可能的日志文件路径
Dim PossibleLogs As New List(Of String)
Try
PossibleLogs.AddRange(DirectoryUtils.GetFiles(VersionPathIndie & "crash-reports\"))
PossibleLogs.AddRange(DirectoryUtils.EnumerateFiles(VersionPathIndie & "crash-reports\", True))
Catch ex As Exception
Logger.Warn(ex, "收集 Minecraft 崩溃日志文件夹下的日志失败")
End Try
Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb
+61 -62
View File
@@ -1,4 +1,4 @@
Public Module ModDownload
Public Module ModDownload
#Region "DlClient* | Minecraft 客户端"
@@ -20,7 +20,7 @@
Throw New Exception("底层版本 " & Instance.Name & " 中无 jar 文件下载信息")
End If
'检查文件
Dim Checker As New FileChecker(MinSize:=1024, ActualSize:=If(Instance.JsonObject("downloads")("client")("size"), -1), Hash:=Instance.JsonObject("downloads")("client")("sha1"))
Dim Checker As New FileChecker With {.MinSize = 1024, .ActualSize = If(Instance.JsonObject("downloads")("client")("size"), -1), .Hash = Instance.JsonObject("downloads")("client")("sha1")}
If ReturnNothingOnFileUseable AndAlso Checker.Check(Instance.PathVersion & Instance.Name & ".jar") Is Nothing Then Return Nothing '通过校验
'返回下载信息
Dim JarUrl As String = Instance.JsonObject("downloads")("client")("url")
@@ -44,14 +44,14 @@
If IndexUrl = "" Then
Return Nothing
Else
Return New NetFile(DlSourceLauncherOrMetaGet(IndexUrl), IndexAddress, New FileChecker(CanUseExistsFile:=False, IsJson:=True))
Return New NetFile(DlSourceLauncherOrMetaGet(IndexUrl), IndexAddress, New FileChecker With {.IsJson = True})
End If
End Function
''' <summary>
''' 构造补全某 Minecraft 版本的所有文件的加载器列表。失败会抛出异常。
''' </summary>
Public Function DlClientFix(Instance As McInstance, CheckAssetsHash As Boolean, AssetsIndexBehaviour As AssetsIndexExistsBehaviour) As List(Of LoaderBase)
Public Function DlClientFix(Instance As McInstance, CheckAssetsHash As Boolean, DownloadAssetIndexInBackground As Boolean) As List(Of LoaderBase)
Dim Loaders As New List(Of LoaderBase)
#Region "下载支持库文件"
@@ -69,6 +69,8 @@
Else
Dim LoadersAssets As New List(Of LoaderBase)
'获取资源文件索引地址
Dim TempAddressMain As String = Nothing
Dim RealAddressMain As String = Nothing
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析资源文件索引地址",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Try
@@ -76,9 +78,16 @@
If IndexFile Is Nothing Then
Task.Output = New List(Of NetFile)
Logger.Warn($"未找到版本 {Instance.Name} 的合适的资源索引下载地址，游戏 assets 可能缺失")
ElseIf AssetsIndexBehaviour <> AssetsIndexExistsBehaviour.AlwaysDownload AndAlso IndexFile.Check.Check(IndexFile.LocalPath) Is Nothing Then
Task.Output = New List(Of NetFile)
Else
ElseIf DownloadAssetIndexInBackground Then
If IndexFile.Check.Check(IndexFile.LocalPath) Is Nothing Then
Task.Output = New List(Of NetFile)
Else
Task.Output = New List(Of NetFile) From {IndexFile}
End If
Else '强制要求重新下载
RealAddressMain = IndexFile.LocalPath
TempAddressMain = PathTemp & "Cache\" & IndexFile.LocalName
IndexFile.LocalPath = TempAddressMain
Task.Output = New List(Of NetFile) From {IndexFile}
End If
Catch ex As Exception
@@ -87,65 +96,55 @@
End Sub) With {.ProgressWeight = 0.5, .Show = False})
'下载资源文件索引
LoadersAssets.Add(New LoaderDownload("下载资源文件索引", New List(Of NetFile)) With {.ProgressWeight = 2})
'要求独立更新索引
If AssetsIndexBehaviour = AssetsIndexExistsBehaviour.DownloadInBackground Then
'获取资源文件地址
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("获取资源文件列表",
Sub(Task)
If TempAddressMain IsNot Nothing Then FileUtils.Move(TempAddressMain, RealAddressMain)
Task.Output = McAssetsFixList(Instance, CheckAssetsHash, Task)
End Sub) With {.ProgressWeight = 0.01})
'下载资源文件
LoadersAssets.Add(New LoaderDownload("下载资源文件", New List(Of NetFile)) With {.ProgressWeight = 25})
'构造加载器
Loaders.Add(New LoaderCombo(Of String)("下载资源文件（主加载器）", LoadersAssets) With {.Block = False, .Show = False, .ProgressWeight = 27})
'后台独立更新索引
If DownloadAssetIndexInBackground Then
Dim RealAddressBg As String = Nothing
Dim TempAddressBg As String = Nothing
Dim LoadersAssetsUpdate As New List(Of LoaderBase)
Dim TempAddress As String = Nothing
Dim RealAddress As String = Nothing
LoadersAssetsUpdate.Add(New LoaderTask(Of String, List(Of NetFile))("后台分析资源文件索引地址",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Dim BackAssetsFile As NetFile = DlClientAssetIndexGet(Instance)
If BackAssetsFile Is Nothing Then
Logger.Warn($"未找到版本 {Instance.Name} 的合适的资源索引下载地址，游戏 assets 可能缺失")
Task.Interrupt()
Throw New ThreadInterruptedException
Task.Cancel()
Throw New OperationCanceledException
End If
RealAddress = BackAssetsFile.LocalPath
TempAddress = PathTemp & "Cache\" & BackAssetsFile.LocalName
BackAssetsFile.LocalPath = TempAddress
RealAddressBg = BackAssetsFile.LocalPath
TempAddressBg = PathTemp & "Cache\" & BackAssetsFile.LocalName & "_background"
BackAssetsFile.LocalPath = TempAddressBg
Task.Output = New List(Of NetFile) From {BackAssetsFile}
'检查是否需要更新：每天只更新一次
If FileUtils.Exists(RealAddress) AndAlso Math.Abs((FileUtils.GetInfo(RealAddress).LastWriteTime.Date - Now.Date).TotalDays) < 1 Then
If FileUtils.Exists(RealAddressBg) AndAlso Math.Abs((FileUtils.GetInfo(RealAddressBg).LastWriteTime.Date - Now.Date).TotalDays) < 1 Then
Logger.Info("无需更新资源文件索引，取消")
Task.Interrupt()
Task.Cancel()
End If
End Sub))
LoadersAssetsUpdate.Add(New LoaderDownload("后台下载资源文件索引", New List(Of NetFile)))
LoadersAssetsUpdate.Add(New LoaderTask(Of List(Of NetFile), String)("后台复制资源文件索引",
Sub(Task As LoaderTask(Of List(Of NetFile), String))
FileUtils.Copy(TempAddress, RealAddress)
McLaunchLog("后台更新资源文件索引成功：" & TempAddress)
FileUtils.Move(TempAddressBg, RealAddressBg)
McLaunchLog("后台更新资源文件索引成功：" & TempAddressBg)
End Sub))
Dim Updater As New LoaderCombo(Of String)("后台更新资源文件索引", LoadersAssetsUpdate)
Logger.Info("开始后台检查资源文件索引")
Updater.Start()
End If
'获取资源文件地址
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("获取资源文件列表",
Sub(Task) Task.Output = McAssetsFixList(Instance, CheckAssetsHash, Task)) With {.ProgressWeight = 0.01})
'下载资源文件
LoadersAssets.Add(New LoaderDownload("下载资源文件", New List(Of NetFile)) With {.ProgressWeight = 25})
'构造加载器
Loaders.Add(New LoaderCombo(Of String)("下载资源文件（主加载器）", LoadersAssets) With {.Block = False, .Show = False, .ProgressWeight = 27})
End If
#End Region
Return Loaders
End Function
Public Enum AssetsIndexExistsBehaviour
''' <summary>
''' 如果文件存在，则不进行下载。
''' </summary>
DontDownload
''' <summary>
''' 如果文件存在，则启动新的下载加载器进行独立的更新。
''' </summary>
DownloadInBackground
''' <summary>
''' 如果文件存在，也同样进行下载。
''' </summary>
AlwaysDownload
End Enum
#End Region
@@ -227,7 +226,7 @@
Public DlClientListMojangLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Mojang", AddressOf DlClientListMojangMain)
Private Sub DlClientListMojangMain(Loader As LoaderTask(Of String, DlClientListResult))
Dim StartTime As Long = GetTimeMs()
Dim Json As JObject = GetJson(NetRequestByClientRetry("https://launchermeta.mojang.com/mc/game/version_manifest.json", RequireJson:=True))
Dim Json As JObject = NetRequestByClientRetry("https://launchermeta.mojang.com/mc/game/version_manifest.json", RequireJson:=True).DeserializeJson()
Try
Dim Versions As JArray = Json("versions")
If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足（" & Json.ToString & "）")
@@ -238,7 +237,7 @@
Logger.Info($"Mojang 官方源加载耗时：{DeltaTime}ms，{If(DlPreferMojang, "可优先使用官方源", "不优先使用官方源")}")
End If
'添加 PCL 特供项
If FileUtils.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(FileUtils.ReadAsString(PathTemp & "Cache\download.json")))
If FileUtils.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(FileUtils.ReadAsJson(PathTemp & "Cache\download.json"))
'返回
Loader.Output = New DlClientListResult With {.IsOfficial = True, .SourceName = "Mojang 官方源", .Value = Json}
'MC 更新提示
@@ -269,12 +268,12 @@
''' </summary>
Public DlClientListBmclapiLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Bmclapi", AddressOf DlClientListBmclapiMain)
Private Sub DlClientListBmclapiMain(Loader As LoaderTask(Of String, DlClientListResult))
Dim Json As JObject = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/mc/game/version_manifest.json", RequireJson:=True))
Dim Json As JObject = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/mc/game/version_manifest.json", RequireJson:=True).DeserializeJson()
Try
Dim Versions As JArray = Json("versions")
If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足（" & Json.ToString & "）")
'添加 PCL 特供项
If FileUtils.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(FileUtils.ReadAsString(PathTemp & "Cache\download.json")))
If FileUtils.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(FileUtils.ReadAsJson(PathTemp & "Cache\download.json"))
'检查是否有要求的版本（#5195）
If Not String.IsNullOrEmpty(Loader.Input) Then
Dim Id = Loader.Input
@@ -308,7 +307,7 @@
DlClientListLoader.WaitForExit(Id, IsForceRestart:=True)
Case LoadState.Loading
DlClientListLoader.WaitForExit(Id)
Case LoadState.Failed, LoadState.Interrupted, LoadState.Waiting
Case LoadState.Failed, LoadState.Canceled, LoadState.Waiting
DlClientListLoader.WaitForExit(Id, IsForceRestart:=True)
End Select
'重新查找版本
@@ -447,7 +446,7 @@
''' </summary>
Public DlOptiFineListBmclapiLoader As New LoaderTask(Of Integer, DlOptiFineListResult)("DlOptiFineList Bmclapi", AddressOf DlOptiFineListBmclapiMain)
Private Sub DlOptiFineListBmclapiMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult))
Dim Json As JArray = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/optifine/versionList", RequireJson:=True))
Dim Json As JArray = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/optifine/versionList", RequireJson:=True).DeserializeJson()
Try
Dim Versions As New List(Of DlOptiFineListEntry)
For Each Token As JObject In Json
@@ -531,8 +530,8 @@
''' </summary>
Public DlForgeListBmclapiLoader As New LoaderTask(Of Integer, DlForgeListResult)("DlForgeList Bmclapi", AddressOf DlForgeListBmclapiMain)
Private Sub DlForgeListBmclapiMain(Loader As LoaderTask(Of Integer, DlForgeListResult))
Dim Result As JArray = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/minecraft",
Encoding:=Encoding.Default, RequireJson:=True))
Dim Result As JArray = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/minecraft",
Encoding:=Encoding.Default, RequireJson:=True).DeserializeJson()
Dim Names As List(Of String) = Result.Select(Function(v) v.ToString).ToList
If Names.Count < 10 Then Throw New Exception("获取到的版本数量不足")
Loader.Output = New DlForgeListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Names}
@@ -738,8 +737,8 @@
''' Forge 版本列表，BMCLAPI。
''' </summary>
Public Sub DlForgeVersionBmclapiMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
Dim Json As JArray = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" &
Loader.Input.Replace("-", "_"), RequireJson:=True)) '兼容 Forge 1.7.10-pre4，#4057
Dim Json As JArray = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" &
Loader.Input.Replace("-", "_"), RequireJson:=True).DeserializeJson() '兼容 Forge 1.7.10-pre4，#4057
Dim Versions As New List(Of DlForgeVersionEntry)
Try
Dim Recommended As String = McDownloadForgeRecommendedGet(Loader.Input)
@@ -1026,7 +1025,7 @@
''' </summary>
Public DlLiteLoaderListOfficialLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Official", AddressOf DlLiteLoaderListOfficialMain)
Private Sub DlLiteLoaderListOfficialMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult))
Dim Result As JObject = GetJson(NetRequestByClientRetry("https://dl.liteloader.com/versions/versions.json", RequireJson:=True))
Dim Result As JObject = NetRequestByClientRetry("https://dl.liteloader.com/versions/versions.json", RequireJson:=True).DeserializeJson()
Try
Dim Json As JObject = Result("versions")
Dim Versions As New List(Of DlLiteLoaderListEntry)
@@ -1054,7 +1053,7 @@
''' </summary>
Public DlLiteLoaderListBmclapiLoader As New LoaderTask(Of Integer, DlLiteLoaderListResult)("DlLiteLoaderList Bmclapi", AddressOf DlLiteLoaderListBmclapiMain)
Private Sub DlLiteLoaderListBmclapiMain(Loader As LoaderTask(Of Integer, DlLiteLoaderListResult))
Dim Result As JObject = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/maven/com/mumfrey/liteloader/versions.json", RequireJson:=True))
Dim Result As JObject = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/maven/com/mumfrey/liteloader/versions.json", RequireJson:=True).DeserializeJson()
Try
Dim Json As JObject = Result("versions")
Dim Versions As New List(Of DlLiteLoaderListEntry)
@@ -1125,7 +1124,7 @@
''' </summary>
Public DlFabricListOfficialLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Official", AddressOf DlFabricListOfficialMain)
Private Sub DlFabricListOfficialMain(Loader As LoaderTask(Of Integer, DlFabricListResult))
Dim Result As JObject = GetJson(NetRequestByClientRetry("https://meta.fabricmc.net/v2/versions", RequireJson:=True))
Dim Result As JObject = NetRequestByClientRetry("https://meta.fabricmc.net/v2/versions", RequireJson:=True).DeserializeJson()
Try
Dim Output = New DlFabricListResult With {.IsOfficial = True, .SourceName = "Fabric 官方源", .Value = Result}
If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项")
@@ -1140,7 +1139,7 @@
''' </summary>
Public DlFabricListBmclapiLoader As New LoaderTask(Of Integer, DlFabricListResult)("DlFabricList Bmclapi", AddressOf DlFabricListBmclapiMain)
Private Sub DlFabricListBmclapiMain(Loader As LoaderTask(Of Integer, DlFabricListResult))
Dim Result As JObject = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/fabric-meta/v2/versions", RequireJson:=True))
Dim Result As JObject = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/fabric-meta/v2/versions", RequireJson:=True).DeserializeJson()
Try
Dim Output = New DlFabricListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Result}
If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项")
@@ -1197,7 +1196,7 @@
Dim Exs As String = ""
For Each Source In Urls
Try
Return GetJson(NetRequestByClient(Source.Url, Method, Content, ContentType, Timeout:=Source.Timeout * 1000, Encoding:=Encoding.UTF8, RequireJson:=True))
Return NetRequestByClient(Source.Url, Method, Content, ContentType, Timeout:=Source.Timeout * 1000, Encoding:=Encoding.UTF8, RequireJson:=True).DeserializeJson()
Catch ex As Exception
Exs += ex.Message + vbCrLf
End Try
@@ -1328,7 +1327,7 @@
If SubLoader.Key.State = LoadState.Finished Then
'检查加载器成功
MainLoader.Output = SubLoader.Key.Output
DlSourceLoaderInterrupt(LoaderList)
DlSourceLoaderCancel(LoaderList)
Return
ElseIf BeforeLoadersAllFailed Then
'此前的加载器全部失败，直接启动后续加载器
@@ -1360,7 +1359,7 @@
End If
Next
If ErrorInfo Is Nothing Then ErrorInfo = New TimeoutException("下载源连接超时")
DlSourceLoaderInterrupt(LoaderList)
DlSourceLoaderCancel(LoaderList)
Throw ErrorInfo
End If
Exit For
@@ -1369,15 +1368,15 @@
Thread.Sleep(10)
WaitCycle += 1
'检查父加载器中断
If MainLoader.IsInterrupted Then
DlSourceLoaderInterrupt(LoaderList)
If MainLoader.IsCanceled Then
DlSourceLoaderCancel(LoaderList)
Return
End If
Loop
End Sub
Private Sub DlSourceLoaderInterrupt(Of InputType, OutputType)(LoaderList As List(Of KeyValuePair(Of LoaderTask(Of InputType, OutputType), Integer)))
Private Sub DlSourceLoaderCancel(Of InputType, OutputType)(LoaderList As List(Of KeyValuePair(Of LoaderTask(Of InputType, OutputType), Integer)))
For Each Loader In LoaderList
If Loader.Key.State = LoadState.Loading Then Loader.Key.Interrupt()
If Loader.Key.State = LoadState.Loading Then Loader.Key.Cancel()
Next
End Sub
Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb
+553 -727
View File
File diff suppressed because it is too large Load Diff
Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb
+121 -284
View File
@@ -1,4 +1,4 @@
Public Module ModLaunch
Public Module ModLaunch
#Region "开始"
@@ -81,7 +81,7 @@
Public McLaunchWatcher As Watcher
Private Sub McLaunchState(Loader As LoaderTask(Of McLaunchOptions, Object))
Select Case McLaunchLoader.State
Case LoadState.Finished, LoadState.Failed, LoadState.Waiting, LoadState.Interrupted
Case LoadState.Finished, LoadState.Failed, LoadState.Waiting, LoadState.Canceled
FrmLaunchLeft.PageChangeToLogin()
Case LoadState.Loading
'在预检测结束后再触发动画
@@ -91,7 +91,7 @@
''' <summary>
''' 指定启动中断时的提示文本。若不为 Nothing 则会显示为绿色。
''' </summary>
Private InterruptHint As String = Nothing
Private CanceledHint As String = Nothing
'实际的启动方法
Private Sub McLaunchStart(Loader As LoaderTask(Of McLaunchOptions, Object))
@@ -102,7 +102,7 @@
McLaunchPrecheck()
McLaunchLog("预检测已通过")
Catch ex As Exception
If Not ex.Message.StartsWithF("$$") Then Hint(ex.Message, HintType.Red)
If Not ex.IsCanceled Then Hint(ex.Message, HintType.Red)
Throw
End Try
Dim IsSavingBatch As Boolean = CurrentLaunchOptions?.SaveBatch IsNot Nothing
@@ -113,7 +113,7 @@
Dim Loaders As New List(Of LoaderBase) From {
New LoaderTask(Of Integer, Integer)("获取 Java", AddressOf McLaunchJava) With {.ProgressWeight = 4, .Block = False},
McLoginLoader, '.ProgressWeight = 15, .Block = False
New LoaderCombo(Of String)("补全文件", DlClientFix(McInstanceSelected, False, AssetsIndexExistsBehaviour.DownloadInBackground)) With {.ProgressWeight = 15, .Show = False},
New LoaderCombo(Of String)("补全文件", DlClientFix(McInstanceSelected, False, True)) With {.ProgressWeight = 15, .Show = False},
New LoaderTask(Of String, Integer)("获取启动参数", AddressOf McLaunchArgumentMain) With {.ProgressWeight = 2},
New LoaderTask(Of Integer, Integer)("解压文件", AddressOf McLaunchNatives) With {.ProgressWeight = 2},
New LoaderTask(Of Integer, Integer)("预启动处理", AddressOf McLaunchPrerun) With {.ProgressWeight = 1},
@@ -138,7 +138,7 @@
If McLoginLoader.State = LoadState.Finished Then McLoginLoader.State = LoadState.Waiting '要求重启登录主加载器，它会自行决定是否启动副加载器
'等待加载器执行并更新 UI
McLaunchLoaderReal = LaunchLoader
InterruptHint = Nothing
CanceledHint = Nothing
LaunchLoader.Start()
'任务栏进度条
LoaderTaskbarAdd(LaunchLoader)
@@ -157,11 +157,11 @@
"Version", McInstanceSelected.VersionDisplayName,
"LoginType", Settings.Get(Of McLoginType)("LoginType").ToString)
End If
Case LoadState.Interrupted
If InterruptHint Is Nothing Then
Case LoadState.Canceled
If CanceledHint Is Nothing Then
Hint(If(IsSavingBatch, "已取消导出启动脚本！", "已取消启动！"), HintType.Blue)
Else
Hint(InterruptHint, HintType.Green)
Hint(CanceledHint, HintType.Green)
End If
Case LoadState.Failed
Throw LaunchLoader.Error
@@ -169,12 +169,12 @@
Throw New Exception("错误的状态改变：" & LaunchLoader.State.ToString())
End Select
Catch ex As Exception
ex.ThrowIfCanceled()
Dim CurrentEx = ex
NextInner:
If CurrentEx.Message.StartsWithF("$") Then
'若有以 $ 开头的错误信息，则以此为准显示提示
'若错误信息为 $$，则不提示
If Not CurrentEx.Message = "$$" Then MyMsgBox(CurrentEx.Message.TrimStart("$"), If(IsSavingBatch, "导出启动脚本失败", "启动失败"))
MyMsgBox(CurrentEx.Message.TrimStart("$"), If(IsSavingBatch, "导出启动脚本失败", "启动失败"))
Throw
ElseIf CurrentEx.InnerException IsNot Nothing Then
'检查下一级错误
@@ -208,7 +208,7 @@ NextInner:
PageOtherTest.MemoryOptimize(False)
Finished = True
End Sub, "Launch Memory Optimize")
Do While Not Finished AndAlso Not Loader.IsInterrupted
Do While Not Finished AndAlso Not Loader.IsCanceled
If Loader.Progress < 0.7 Then
Loader.Progress += 0.007 '10s
Else
@@ -273,7 +273,7 @@ NextInner:
Hint("游戏将以试玩模式启动！", HintType.Red)
CurrentLaunchOptions.ExtraGameArgs.Add("--demo")
Case 3
Throw New Exception("$$")
Throw New OperationCanceledException
End Select
End If
End If
@@ -353,7 +353,8 @@ NextInner:
Type = McLoginType.Ms
End Sub
Public Overrides Function GetHashCode() As Integer
Return (OAuthRefreshToken & AccessToken & Uuid & UserName & ProfileJson).GetStableHashCode() Mod Integer.MaxValue
'不能使用全部信息，这俩就足以在登录输入时确保是同一个用户了
Return (OAuthRefreshToken & UserName).GetStableHashCode() Mod Integer.MaxValue
End Function
End Class
Public Class McLoginLegacy
@@ -465,7 +466,7 @@ NextInner:
Public McLoginLoader As New LoaderTask(Of McLoginData, McLoginResult)("登录", AddressOf McLoginStart, AddressOf McLoginInput, ThreadPriority.BelowNormal) With {.ReloadTimeout = 1, .ProgressWeight = 15, .Block = False}
Public Function McLoginInput() As McLoginData
Dim LoginData As McLoginData = Nothing
Dim LoginType As McLoginType = Settings.Get(Of McLoginType)("LoginType")
Dim LoginType = Settings.Get(Of McLoginType)("LoginType")
Try
Select Case LoginType
Case McLoginType.Legacy
@@ -489,10 +490,10 @@ NextInner:
LoginData = PageLoginAuthSkin.GetLoginData()
End If
End Select
Return LoginData
Catch ex As Exception
Logger.Error(ex, $"获取登录输入信息失败（{LoginType}）")
Throw New Exception($"获取登录输入信息失败（{LoginType}）", ex)
End Try
Return LoginData
End Function
Private Sub McLoginStart(Data As LoaderTask(Of McLoginData, McLoginResult))
McLaunchLog("登录加载已开始")
@@ -559,24 +560,24 @@ Relogin:
OAuthTokens = MsLoginStep1Refresh(Input.OAuthRefreshToken)
If OAuthTokens.OAuthAccessToken = "Relogin" Then GoTo Relogin '要求重新打开登录网页认证
End If
If Data.IsInterrupted Then Throw New ThreadInterruptedException
If Data.IsCanceled Then Throw New OperationCanceledException
Data.Progress = 0.25
If Data.IsInterrupted Then Throw New ThreadInterruptedException
If Data.IsCanceled Then Throw New OperationCanceledException
Dim OAuthAccessToken As String = OAuthTokens.OAuthAccessToken
Dim OAuthRefreshToken As String = OAuthTokens.OAuthRefreshToken
Dim XBLToken As String = MsLoginStep2(OAuthAccessToken)
Data.Progress = 0.4
If Data.IsInterrupted Then Throw New ThreadInterruptedException
If Data.IsCanceled Then Throw New OperationCanceledException
Dim Tokens = MsLoginStep3(XBLToken)
Data.Progress = 0.55
If Data.IsInterrupted Then Throw New ThreadInterruptedException
If Data.IsCanceled Then Throw New OperationCanceledException
Dim LoginResult = MsLoginStep4(Tokens)
ExpiresAt = LoginResult.ExpiresAt
Data.Progress = 0.7
If Data.IsInterrupted Then Throw New ThreadInterruptedException
If Data.IsCanceled Then Throw New OperationCanceledException
MsLoginStep5(LoginResult.AccessToken)
Data.Progress = 0.85
If Data.IsInterrupted Then Throw New ThreadInterruptedException
If Data.IsCanceled Then Throw New OperationCanceledException
Dim Result = MsLoginStep6(LoginResult.AccessToken)
Data.Progress = 0.98
'输出登录结果
@@ -586,14 +587,14 @@ Relogin:
Settings.Set("CacheMsV2Name", Result.UserName)
Settings.Set("CacheMsV2ProfileJson", Result.ProfileJson)
Settings.Set("CacheMsV2Expires", LoginResult.ExpiresAt)
Dim MsJson As JObject = GetJson(Settings.Get(Of String)("LoginMsJson"))
Dim MsJson As JObject = Settings.Get(Of String)("LoginMsJson").DeserializeJson()
MsJson.Remove(Input.UserName) '如果更改了玩家名……
MsJson(Result.UserName) = OAuthRefreshToken
Settings.Set("LoginMsJson", MsJson.ToString(Newtonsoft.Json.Formatting.None))
Data.Output = New McLoginResult With {.AccessToken = LoginResult.AccessToken, .Name = Result.UserName, .Uuid = Result.UUID, .Type = "Microsoft", .ClientToken = Result.UUID, .ProfileJson = Result.ProfileJson}
'结束
SkipLogin:
McLaunchLog($"微软登录结束，AccessToken 将在 {DateTimeOffset.FromUnixTimeSeconds(ExpiresAt).Date.ToLocalTime} 过期")
McLaunchLog($"微软登录结束，AccessToken 将在 {DateTimeOffset.FromUnixTimeSeconds(ExpiresAt).LocalDateTime} 过期")
Settings.Set("HintBuy", True) '关闭正版购买提示
If ThemeUnlock(10, False) Then MyMsgBox("感谢你对正版游戏的支持！" & vbCrLf & "隐藏主题 跳票红 已解锁！", "提示")
End Sub
@@ -612,7 +613,7 @@ SkipLogin:
Settings.Get(Of String)("Cache" & Input.Token & "Name") <> "" Then
'尝试验证登录
Try
If Data.IsInterrupted Then Throw New ThreadInterruptedException
If Data.IsCanceled Then Throw New OperationCanceledException
McLoginRequestValidate(Data)
GoTo LoginFinish
Catch ex As Exception
@@ -623,7 +624,7 @@ SkipLogin:
'尝试刷新登录
Refresh:
Try
If Data.IsInterrupted Then Throw New ThreadInterruptedException
If Data.IsCanceled Then Throw New OperationCanceledException
McLoginRequestRefresh(Data, NeedRefresh)
GoTo LoginFinish
Catch ex As Exception
@@ -634,7 +635,7 @@ Refresh:
End If
'尝试普通登录
Try
If Data.IsInterrupted Then Throw New ThreadInterruptedException
If Data.IsCanceled Then Throw New OperationCanceledException
NeedRefresh = McLoginRequestLogin(Data)
Catch ex As Exception
McLaunchLog("登录失败：" & ex.GetDisplay(True))
@@ -718,7 +719,7 @@ LoginFinish:
End Sub
Private Sub McLoginRequestRefresh(ByRef Data As LoaderTask(Of McLoginServer, McLoginResult), RequestUser As Boolean)
McLaunchLog("刷新登录开始（Refresh, " & Data.Input.Token & "）")
Dim LoginJson As JObject = GetJson(NetRequestByClientRetry(
Dim LoginJson As JObject = NetRequestByClientRetry(
Data.Input.BaseUrl & "/refresh", HttpMethod.Post,
Content:=New JObject(
New JProperty("selectedProfile", New JObject(
@@ -729,7 +730,7 @@ LoginFinish:
New JProperty("requestUser", True)
).ToString(Newtonsoft.Json.Formatting.None),
Headers:={{"Accept-Language", "zh-CN"}},
ContentType:="application/json; charset=utf-8", RequireJson:=True))
ContentType:="application/json; charset=utf-8", RequireJson:=True).DeserializeJson()
'将登录结果输出
If LoginJson("selectedProfile") Is Nothing Then Throw New Exception("选择的角色 " & Settings.Get(Of String)("Cache" & Data.Input.Token & "Name") & " 无效！")
Data.Output.AccessToken = LoginJson("accessToken").ToString
@@ -755,11 +756,11 @@ LoginFinish:
New JProperty("username", Data.Input.UserName),
New JProperty("password", Data.Input.Password),
New JProperty("requestUser", True))
Dim LoginJson As JObject = GetJson(NetRequestByClientRetry(
Dim LoginJson As JObject = NetRequestByClientRetry(
Data.Input.BaseUrl & "/authenticate", HttpMethod.Post,
Content:=RequestData.ToString(Newtonsoft.Json.Formatting.None),
Headers:={{"Accept-Language", "zh-CN"}},
ContentType:="application/json; charset=utf-8", RequireJson:=True))
ContentType:="application/json; charset=utf-8", RequireJson:=True).DeserializeJson()
'检查登录结果
If LoginJson("availableProfiles").Count = 0 Then
If Data.Input.ForceReselectProfile Then Hint("你还没有创建角色，无法更换！", HintType.Red)
@@ -824,7 +825,7 @@ LoginFinish:
Dim ErrorMessage As String = Nothing
Try
Dim Response = DirectCast(ex, HttpRequestCodeException).Response
If Response.ContainsIgnoreCase("errorMessage") Then ErrorMessage = GetJson(Response)("errorMessage").ToString()
If Response.ContainsIgnoreCase("errorMessage") Then ErrorMessage = Response.DeserializeJson()("errorMessage").ToString()
Catch
End Try
If Not String.IsNullOrWhiteSpace(ErrorMessage) Then
@@ -874,14 +875,14 @@ LoginFinish:
'初始请求
Retry:
McLaunchLog("开始微软登录步骤 1/6（原始登录）")
Dim PrepareJson As JObject = GetJson(NetRequestByClientRetry("https://login.microsoftonline.com/consumers/oauth2/v2.0/devicecode", HttpMethod.Post,
Dim PrepareJson As JObject = NetRequestByClientRetry("https://login.microsoftonline.com/consumers/oauth2/v2.0/devicecode", HttpMethod.Post,
Content:=$"client_id={OAuthClientId}&tenant=/consumers&scope=XboxLive.signin%20offline_access",
ContentType:="application/x-www-form-urlencoded", RequireJson:=True))
ContentType:="application/x-www-form-urlencoded", RequireJson:=True).DeserializeJson()
McLaunchLog("网页登录地址：" & PrepareJson("verification_uri").ToString)
'弹窗
Dim Converter As New MyMsgBoxConverter With {.Content = PrepareJson, .ForceWait = True, .Type = MyMsgBoxType.Login}
WaitingMyMsgBox.Add(Converter)
WaitingMyMsgBox.Enqueue(Converter)
While Converter.Result Is Nothing
Thread.Sleep(100)
End While
@@ -891,7 +892,7 @@ Retry:
Button2Action:=Sub() OpenWebsite("https://account.live.com/password/Change")) = 1 Then
GoTo Retry
Else
Throw New Exception("$$")
Throw New OperationCanceledException
End If
ElseIf TypeOf Converter.Result Is Exception Then
Throw CType(Converter.Result, Exception)
@@ -906,7 +907,7 @@ Retry:
Dim Result As String
Try
Result = NetRequestByClientMultiple("https://login.live.com/oauth20_token.srf", HttpMethod.Post,
Content:=$"client_id={OAuthClientId}&refresh_token={EscapeUtils.FormUrlEscape(Code)}&grant_type=refresh_token&scope=XboxLive.signin%20offline_access",
Content:=$"client_id={OAuthClientId}&refresh_token={StringUtils.FormUrlEscape(Code)}&grant_type=refresh_token&scope=XboxLive.signin%20offline_access",
ContentType:="application/x-www-form-urlencoded",
Headers:={{"Accept-Language", "en-US,en;q=0.5"}, {"X-Requested-With", "XMLHttpRequest"}},
ThreadCount:=2)
@@ -919,16 +920,16 @@ Retry:
Return ("Relogin", "")
ElseIf Response.Contains("Account security interrupt") Then
MyMsgBox("该账号由于安全问题无法登陆，请前往微软账户页获取更多信息。", "登录失败", "我知道了", IsWarn:=True)
Throw New Exception("$$")
Throw New OperationCanceledException
ElseIf Response.Contains("service abuse") Then
MyMsgBox("非常抱歉，该账号已被微软封禁，无法登录。", "登录失败", "我知道了", IsWarn:=True)
Throw New Exception("$$")
Throw New OperationCanceledException
Else
Throw
End If
End Try
Dim ResultJson As JObject = GetJson(Result)
Dim ResultJson As JObject = Result.DeserializeJson()
Dim AccessToken As String = ResultJson("access_token").ToString
Dim RefreshToken As String = ResultJson("refresh_token").ToString
Return (AccessToken, RefreshToken)
@@ -946,9 +947,8 @@ Retry:
""RelyingParty"": ""http://auth.xboxlive.com"",
""TokenType"": ""JWT""
}"
Dim Result As String = NetRequestByClientMultiple("https://user.auth.xboxlive.com/user/authenticate", HttpMethod.Post,
Content:=Request, ContentType:="application/json", RequireJson:=True)
Return GetJson(Result)("Token").ToString
Return NetRequestByClientMultiple("https://user.auth.xboxlive.com/user/authenticate", HttpMethod.Post,
Content:=Request, ContentType:="application/json", RequireJson:=True).DeserializeJson()("Token").ToString
End Function
'微软登录步骤 3：从 XBLToken 获取 {XSTSToken, UHS}
Private Function MsLoginStep3(XBLToken As String) As (XSTSToken As String, UHS As String)
@@ -970,15 +970,15 @@ Retry:
'参考 https://github.com/PrismarineJS/prismarine-auth/blob/master/src/common/Constants.js
If ex.Response.Contains("2148916227") Then
MyMsgBox("该账号似乎已被微软封禁，无法登录。", "登录失败", "我知道了", IsWarn:=True)
Throw New Exception("$$")
Throw New OperationCanceledException
ElseIf ex.Response.Contains("2148916233") Then
If MyMsgBox("你尚未注册 Xbox 账户，请在注册后再登录。", "登录提示", "注册", "取消") = 1 Then
OpenWebsite("https://signup.live.com/signup")
End If
Throw New Exception("$$")
Throw New OperationCanceledException
ElseIf ex.Response.Contains("2148916235") Then
MyMsgBox($"你的网络所在的国家或地区无法登录微软账号。{vbCrLf}请使用加速器或 VPN，然后再试。", "登录失败", "我知道了")
Throw New Exception("$$")
Throw New OperationCanceledException
ElseIf ex.Response.Contains("2148916238") Then
If MyMsgBox("该账号年龄不足，你需要先修改出生日期，然后才能登录。" & vbCrLf &
"该账号目前填写的年龄是否在 13 岁以上？", "登录提示", "13 岁以上", "12 岁以下", "我不知道") = 1 Then
@@ -990,13 +990,13 @@ Retry:
MyMsgBox("请根据打开的网页的说明，修改账号的出生日期（至少改为 18 岁以上）。" & vbCrLf &
"在修改成功后等待一分钟，然后再回到 PCL，就可以正常登录了！", "登录提示")
End If
Throw New Exception("$$")
Throw New OperationCanceledException
Else
Throw
End If
End Try
Dim ResultJson As JObject = GetJson(Result)
Dim ResultJson As JObject = Result.DeserializeJson()
Return (
ResultJson("Token").ToString(), 'XSTSToken
ResultJson("DisplayClaims")("xui")(0)("uhs").ToString() 'UHS
@@ -1018,15 +1018,18 @@ Retry:
ElseIf ex.StatusCode = HttpStatusCode.Forbidden Then
Logger.Warn(ex, "微软登录第 4 步汇报 403")
Throw New Exception("$当前 IP 的登录尝试异常。" & vbCrLf & "如果你使用了 VPN 或加速器，请把它们关掉或更换节点后再试！")
ElseIf ex.StatusCode = HttpStatusCode.ServiceUnavailable Then
Logger.Warn(ex, "微软登录第 4 步汇报 503")
Throw New Exception("$Mojang 服务器出现问题，请稍后再试。" & vbCrLf & "你的网络是正常的，PCL 也是正常的，是 Mojang 出问题了……")
ElseIf ex.Response?.Contains("ACCOUNT_SUSPENDED") Then '#8655
MyMsgBox("该账号似乎已被微软封禁，无法登录。", "登录失败", "我知道了", IsWarn:=True)
Throw New Exception("$$")
Throw New OperationCanceledException
Else
Throw
End If
End Try
Dim ResultJson As JObject = GetJson(Result)
Dim ResultJson As JObject = Result.DeserializeJson()
Return (
ResultJson("access_token").ToString,
ResultJson("expires_in").ToObject(Of Integer) + GetUnixTimestampUtc() - 1200) '提前 20 分钟视作过期
@@ -1038,13 +1041,13 @@ Retry:
Dim Result As String = NetRequestByClientMultiple("https://api.minecraftservices.com/entitlements/mcstore",
ContentType:="application/json", ThreadCount:=2, Headers:={{"Authorization", "Bearer " & AccessToken}}, RequireJson:=True)
Try
Dim ResultJson As JObject = GetJson(Result)
Dim ResultJson As JObject = Result.DeserializeJson()
If Not (ResultJson.ContainsKey("items") AndAlso ResultJson("items").Any) Then
Select Case MyMsgBox("你尚未购买正版 Minecraft，或者 Xbox Game Pass 已到期。", "登录失败", "购买 Minecraft", "取消")
Case 1
OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj")
End Select
Throw New Exception("$$")
Throw New OperationCanceledException
End If
Catch ex As Exception
Logger.Warn(ex, $"微软登录第 5 步异常：{Result}")
@@ -1073,12 +1076,12 @@ Retry:
OpenWebsite("https://www.minecraft.net/zh-hans/msaprofile/mygames/editprofile")
End Select
End Sub, "Login Failed: Create Profile")
Throw New Exception("$$")
Throw New OperationCanceledException
Case Else
Throw
End Select
End Try
Dim ResultJson As JObject = GetJson(Result)
Dim ResultJson As JObject = Result.DeserializeJson()
Dim UUID As String = ResultJson("id").ToString
Dim UserName As String = ResultJson("name").ToString
Return (UUID, UserName, Result)
@@ -1131,7 +1134,7 @@ Retry:
If Len(Uuid) = 32 Then Return Uuid
'从官网获取
Try
Dim GotJson As JObject = GetJson(NetRequestByClientRetry("https://api.mojang.com/users/profiles/minecraft/" & Name, RequireJson:=True))
Dim GotJson As JObject = NetRequestByClientRetry("https://api.mojang.com/users/profiles/minecraft/" & Name, RequireJson:=True).DeserializeJson()
If GotJson Is Nothing Then Throw New FileNotFoundException("正版玩家档案不存在（" & Name & "）")
Uuid = If(GotJson("id"), "")
Catch ex As Exception
@@ -1156,183 +1159,16 @@ Retry:
#Region "Java 处理"
Public McLaunchJavaSelected As JavaEntry = Nothing
Public McLaunchJavaSelected As Java = Nothing
Private Sub McLaunchJava(Task As LoaderTask(Of Integer, Integer))
Dim MinVer As New Version(0, 0, 0, 0), MaxVer As New Version(999, 999, 999, 999)
'原版 26-：通过版本号判断
If (Not McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.ReleaseTime >= New Date(2024, 4, 2)) OrElse
(McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.Version.Vanilla >= New Version(20, 0, 5)) Then
'1.20.5+（24w14a+）：至少 Java 21
MinVer = New Version(1, 21, 0, 0)
ElseIf (Not McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.ReleaseTime >= New Date(2021, 11, 16)) OrElse
(McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.Version.Vanilla.Major >= 18) Then
'1.18 pre2+：至少 Java 17
MinVer = New Version(1, 17, 0, 0)
ElseIf (Not McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.ReleaseTime >= New Date(2021, 5, 11)) OrElse
(McInstanceSelected.Version.Vaild AndAlso McInstanceSelected.Version.Vanilla.Major >= 17) Then
'1.17+ (21w19a+)：至少 Java 16
MinVer = New Version(1, 16, 0, 0)
ElseIf McInstanceSelected.ReleaseTime.Year >= 2017 Then 'Minecraft 1.12 与 1.11 的分界线正好是 2017 年，太棒了
'1.12+：至少 Java 8
MinVer = New Version(1, 8, 0, 0)
ElseIf McInstanceSelected.ReleaseTime <= New Date(2013, 5, 1) AndAlso McInstanceSelected.ReleaseTime.Year >= 2001 Then '避免某些版本写个 1960 年
'1.5.2-：最高 Java 8
MaxVer = New Version(1, 8, 999, 999)
McLaunchJavaSelected = SelectOrDownloadJava(McInstanceSelected, True, Task.CreateCancellationToken, Task.CreateSyncProgressProvider)
If Task.IsCanceled Then Return
If McLaunchJavaSelected Is Nothing Then Throw New OperationCanceledException 'SelectOrDownloadJava 已经会给予适当的提示
If ModeDebug Then
McLaunchLog($"预期 Java 版本范围：{GetJavaRequirement(McInstanceSelected).Range}")
McLaunchLog($"Java 版本设置类别：{Settings.Get(Of Integer)("VersionArgumentJavaV2", McInstanceSelected)}")
End If
'原版 26+：获取 Mojang 要求的 Java 版本
Dim RecommendedComponent As String = Nothing
Dim RecommendedCode As Integer =
If(McInstanceSelected.JsonObject?("javaVersion")?("majorVersion")?.ToObject(Of Integer),
If(McInstanceSelected.JsonVersion?("java_version")?.ToObject(Of Integer), 0))
If RecommendedCode >= 22 Then
McLaunchLog("Mojang 要求至少使用 Java " & RecommendedCode)
MinVer = New Version(1, RecommendedCode, 0, 0)
RecommendedComponent =
If(McInstanceSelected.JsonObject?("javaVersion")?("component")?.ToString,
McInstanceSelected.JsonVersion?("java_component")?.ToString)
If RecommendedComponent = "" Then RecommendedComponent = Nothing
End If
'OptiFine 检测
If McInstanceSelected.Version.HasOptiFine AndAlso McInstanceSelected.Version.Vaild Then '不管非标准版本
If McInstanceSelected.Version.Vanilla.Major < 7 Then
'<1.7：至多 Java 8
MaxVer = New Version(1, 8, 999, 999)
ElseIf McInstanceSelected.Version.Vanilla.Major >= 8 AndAlso McInstanceSelected.Version.Vanilla.Major < 12 Then
'1.8 - 1.11：必须恰好 Java 8
MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 8, 999, 999)
ElseIf McInstanceSelected.Version.Vanilla.Major = 12 Then
'1.12：最高 Java 8
MaxVer = New Version(1, 8, 999, 999)
End If
End If
'Forge 检测（部分测试结果见 #8432）
If McInstanceSelected.Version.HasForge Then
If McInstanceSelected.Version.Vanilla >= New Version(6, 0, 1) AndAlso McInstanceSelected.Version.Vanilla <= New Version(7, 0, 2) Then
'1.6.1 - 1.7.2：必须 Java 7
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 McInstanceSelected.Version.Vanilla.Major <= 12 OrElse Not McInstanceSelected.Version.Vaild Then '非标准版本
'<=1.12：Java 8
MaxVer = New Version(1, 8, 999, 999)
ElseIf McInstanceSelected.Version.Vanilla.Major <= 14 Then
'1.13 - 1.14：Java 8 - 10
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 McInstanceSelected.Version.Vanilla.Major = 15 Then
'1.15：Java 8 - 15
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 CompareVersionGE(McInstanceSelected.Version.Forge, "34.0.0") AndAlso CompareVersionGE("36.2.25", McInstanceSelected.Version.Forge) Then
'1.16.3~5，Forge 34.0.0 ~ 36.2.25：最高 Java 8u320
MaxVer = If(New Version(1, 8, 0, 320) < MaxVer, New Version(1, 8, 0, 320), MaxVer)
ElseIf CompareVersionGE(McInstanceSelected.Version.Forge, "36.2.26") AndAlso CompareVersionGE("36.999.999", McInstanceSelected.Version.Forge) Then
'1.16.5，Forge 36.2.26+，<37.0.0：最高 Java 23
MaxVer = If(New Version(1, 23, 999, 999) < MaxVer, New Version(1, 23, 999, 999), MaxVer)
ElseIf CompareVersionGE(McInstanceSelected.Version.Forge, "37.0.0") AndAlso CompareVersionGE("37.0.79", McInstanceSelected.Version.Forge) Then
'1.17.1，Forge 37.0.0 ~ 37.0.79：最高 Java 16
MaxVer = If(New Version(1, 16, 999, 999) < MaxVer, New Version(1, 16, 999, 999), MaxVer)
ElseIf McInstanceSelected.Version.Vanilla.Major = 18 AndAlso McInstanceSelected.Version.HasOptiFine Then '#305
'1.18：若安装了 OptiFine，最高 Java 18
MaxVer = If(New Version(1, 18, 999, 999) < MaxVer, New Version(1, 18, 999, 999), MaxVer)
ElseIf CompareVersionGE(McInstanceSelected.Version.Forge, "45.0.21") AndAlso CompareVersionGE("45.0.65", McInstanceSelected.Version.Forge) Then
'1.19.4，Forge 45.0.21 ~ 45.0.65：最高 Java 19
MaxVer = If(New Version(1, 19, 999, 999) < MaxVer, New Version(1, 19, 999, 999), MaxVer)
ElseIf CompareVersionGE(McInstanceSelected.Version.Forge, "45.0.66") AndAlso CompareVersionGE("47.4.8", McInstanceSelected.Version.Forge) Then
'1.19.4~1.20.1，Forge 45.0.66 ~ 47.4.8：最高 Java 21
MaxVer = If(New Version(1, 21, 999, 999) < MaxVer, New Version(1, 21, 999, 999), MaxVer)
End If
End If
'NeoForge 检测
If McInstanceSelected.Version.HasNeoForge Then
If McInstanceSelected.Version.Vanilla = New Version(20, 0, 1) OrElse
(CompareVersionGE("20.2.62-beta", McInstanceSelected.Version.NeoForge) AndAlso Not McInstanceSelected.Version.NeoForge.Contains("25w14craftmine")) Then
'1.20.1，以及 1.20.2 的 20.2.62-beta 之前：最高 Java 21
MaxVer = If(New Version(1, 21, 999, 999) < MaxVer, New Version(1, 21, 999, 999), MaxVer)
End If
End If
'Fabric 检测
If McInstanceSelected.Version.HasFabric AndAlso McInstanceSelected.Version.Vaild Then '不管非标准版本
If McInstanceSelected.Version.Vanilla.Major >= 15 AndAlso McInstanceSelected.Version.Vanilla.Major <= 16 Then
'1.15 - 1.16：Java 8+
MinVer = If(New Version(1, 8, 0, 0) > MinVer, New Version(1, 8, 0, 0), MinVer)
ElseIf McInstanceSelected.Version.Vanilla.Major >= 18 Then
'1.18+：Java 17+
MinVer = If(New Version(1, 17, 0, 0) > MinVer, New Version(1, 17, 0, 0), MinVer)
End If
End If
'LiteLoader 检测
If McInstanceSelected.Version.HasLiteLoader AndAlso McInstanceSelected.Version.Vaild Then '不管非标准版本
'最高 Java 8
MaxVer = If(New Version(1, 8, 999, 999) < MaxVer, New Version(1, 8, 999, 999), MaxVer)
End If
'统一通行证检测
If Settings.Get(Of McLoginType)("LoginType") = McLoginType.Nide Then
'至少 Java 8u101
MinVer = If(New Version(1, 8, 0, 141) > MinVer, New Version(1, 8, 0, 141), MinVer)
End If
SyncLock JavaLock
'选择 Java
McLaunchLog("Java 版本需求：最低 " & MinVer.ToString & "，最高 " & MaxVer.ToString)
McLaunchJavaSelected = JavaSelect("$$", MinVer, MaxVer, McInstanceSelected)
If Task.IsInterrupted Then Return
If McLaunchJavaSelected IsNot Nothing Then
McLaunchLog("选择的 Java：" & McLaunchJavaSelected.ToString)
Return
End If
'无合适的 Java
If Task.IsInterrupted Then Return '中断加载会导致 JavaSelect 异常地返回空值，误判找不到 Java
McLaunchLog("无合适的 Java，准备自动下载")
Dim JavaCode As String
If MinVer >= New Version(1, 9) Then
JavaCode = MinVer.Minor
ElseIf MaxVer < New Version(1, 8) Then
MyMsgBox($"你需要安装 Java 7 才能启动该版本。{vbCrLf}请自行搜索并安装 Java 7，安装后在 设置 → 启动选项 → 游戏 Java 中重新搜索或导入。", "未找到 Java")
Throw New Exception("$$")
ElseIf MinVer > New Version(1, 8, 0, 140) AndAlso MaxVer < New Version(1, 8, 0, 321) Then
MyMsgBox($"你需要安装 Java 8u141 ~ 8u320 才能启动该版本。{vbCrLf}请自行搜索并安装，安装后在 设置 → 启动选项 → 游戏 Java 中重新搜索或导入。", "未找到 Java")
Throw New Exception("$$")
ElseIf MinVer > New Version(1, 8, 0, 140) Then
MyMsgBox($"你需要安装 Java 8u141 或更高版本的 Java 8 才能启动该版本。{vbCrLf}请自行搜索并安装，安装后在 设置 → 启动选项 → 游戏 Java 中重新搜索或导入。", "未找到 Java")
Throw New Exception("$$")
Else
JavaCode = 8
End If
'开始自动下载
Dim JavaLoader = GetJavaDownloadLoader()
Try
JavaLoader.Start(If(RecommendedComponent, JavaCode), IsForceRestart:=True) '在 Java 22+ 时优先使用 Mojang 提供的 Component 字段
Do While JavaLoader.State = LoadState.Loading AndAlso Not Task.IsInterrupted
Task.Progress = JavaLoader.Progress
Thread.Sleep(10)
Loop
Finally
JavaLoader.Interrupt() '确保取消时中止 Java 下载
End Try
'检查下载结果
If JavaSearchLoader.State <> LoadState.Loading Then JavaSearchLoader.State = LoadState.Waiting '2872#
McLaunchJavaSelected = JavaSelect("$$", MinVer, MaxVer, McInstanceSelected)
If Task.IsInterrupted Then Return
If McLaunchJavaSelected IsNot Nothing Then
McLaunchLog("选择的 Java：" & McLaunchJavaSelected.ToString)
Else
Hint("没有可用的 Java，已取消启动！", HintType.Red)
Throw New Exception("$$")
End If
End SyncLock
McLaunchLog("选择的 Java：" & McLaunchJavaSelected.ToString)
End Sub
#End Region
@@ -1427,7 +1263,7 @@ NextInstance:
End If
'Authlib-Injector
If McLoginLoader.Output.Type = "Auth" Then
If McLaunchJavaSelected.MajorVersion >= 6 Then Args.Add("-Djavax.net.ssl.trustStoreType=WINDOWS-ROOT") '信任系统根证书（5252#）
If McLaunchJavaSelected.Version.Major >= 6 Then Args.Add("-Djavax.net.ssl.trustStoreType=WINDOWS-ROOT") '信任系统根证书（5252#）
Dim Server As String = Settings.Get(Of String)("VersionServerAuthServer", Instance:=McInstanceSelected)
Try
McLaunchLog($"开始 Authlib Injector Prefetch")
@@ -1444,13 +1280,13 @@ NextInstance:
'非 GBK 编码下命令行参数乱码的问题（JDK-8272352）
Dim UseJLW As Boolean =
Not Settings.Get(Of Boolean)("LaunchAdvanceDisableJLW") AndAlso Not Settings.Get(Of Boolean)("VersionAdvanceDisableJLW", McInstanceSelected) AndAlso
Not IsGBKEncoding AndAlso Not McFolderSelected.IsAsciiOnly() '仅在该环境下才会触发该 Bug
Not IsGBKEncoding '即使游戏文件夹名称不含非 ASCII 字符，但玩家名等也可能出现中文，因此依然需要 JLW（#8739）
If UseJLW AndAlso CustomArg.Contains("-javaagent") Then
UseJLW = False
McLaunchLog("由于使用了自定义 javaagent，已禁用 JLW，这可能导致游戏崩溃！", LogLevel.Warn)
End If
If UseJLW Then
If McLaunchJavaSelected.MajorVersion >= 9 Then
If McLaunchJavaSelected.Version.Major >= 9 Then
Args.Add("--add-exports") : Args.Add("cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
End If
Args.Add("-Doolloo.jlw.tmpdir=${pure_directory}") '这里需要不以 \ 结尾
@@ -1467,7 +1303,7 @@ NextInstance:
#Region "内存管理"
McLaunchLog("当前剩余内存：" & Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10 & "G")
Dim TargetRam As Integer = Math.Floor(PageInstanceSetup.GetRam(McInstanceSelected, Not McLaunchJavaSelected.Is64Bit) * 1024)
Dim TargetRam As Integer = Math.Floor(PageInstanceSetup.GetRam(McInstanceSelected) * 1024)
Args.Add("-Xmx" & TargetRam & "m")
'获取设置的管理方式
@@ -1480,17 +1316,17 @@ NextInstance:
If SetupType <> 3 Then
'确定是使用 G1GC 还是 ZGC
Dim UseG1GC As Boolean = False
If (SetupType = 0 AndAlso McLaunchJavaSelected.MajorVersion < 15) OrElse
(SetupType = 1 AndAlso McLaunchJavaSelected.MajorVersion < 21) OrElse
If (SetupType = 0 AndAlso McLaunchJavaSelected.Version.Major < 15) OrElse
(SetupType = 1 AndAlso McLaunchJavaSelected.Version.Major < 21) OrElse
(SetupType = 2 OrElse SetupType = 4) Then UseG1GC = True '检查 Java 版本，ZGC 在 Java 15+ 可用，分代 ZGC 在 Java 21+ 可用
If Is32BitSystem OrElse Environment.OSVersion.Version.Major < 10 OrElse Environment.OSVersion.Version.Build < 17763 Then UseG1GC = True '检查系统兼容性，ZGC 需要 Windows 10 1809+
McLaunchLog($"GC 设置：{SetupType}，选取 {If(UseG1GC, "G1GC", "ZGC")}，Java 版本：{McLaunchJavaSelected.MajorVersion}")
If Environment.OSVersion.Version.Major < 10 OrElse Environment.OSVersion.Version.Build < 17763 Then UseG1GC = True '检查系统兼容性，ZGC 需要 Windows 10 1809+
McLaunchLog($"GC 设置：{SetupType}，选取 {If(UseG1GC, "G1GC", "ZGC")}，Java 版本：{McLaunchJavaSelected.Version.Major}")
'移除已有的 GC 参数
Args = Args.Where(Function(a) Not a.RegexCheck(
"( )*-XX:[+-]?(Use\w+GC|ZGenerational|UseCompactObjectHeaders|G1\w+Percent|G1\w+Size|(Max|Min)(GCPauseMillis|HeapFreeRatio))")).ToList
'添加 GC 参数
Args.Add("-XX:+UnlockExperimentalVMOptions")
If McLaunchJavaSelected.MajorVersion >= 24 AndAlso McLaunchJavaSelected.Is64Bit Then Args.Add("-XX:+UseCompactObjectHeaders")
If McLaunchJavaSelected.Version.Major >= 24 Then Args.Add("-XX:+UseCompactObjectHeaders")
If UseG1GC AndAlso SetupType = 4 Then
'优化的 G1GC
Args.Add("-XX:+UseG1GC")
@@ -1499,10 +1335,10 @@ NextInstance:
Args.Add("-XX:G1HeapRegionSize=32M")
Args.Add("-XX:MaxGCPauseMillis=50")
If Not ModeDebug Then Args.Add("-XX:+PerfDisableSharedMem")
If McLaunchJavaSelected.MajorVersion <= 7 Then Args.Add("-XX:MaxPermSize=512m") '#8286
If McLaunchJavaSelected.MajorVersion = 8 Then Args.Add("-XX:+ParallelRefProcEnabled")
If McLaunchJavaSelected.MajorVersion >= 12 Then Args.Add("-XX:MinHeapFreeRatio=25") '需要比 G1NewSizePercent 大一点
If McLaunchJavaSelected.MajorVersion >= 12 Then Args.Add("-XX:MaxHeapFreeRatio=40") '需要比 MinHeapFreeRatio 大一些
If McLaunchJavaSelected.Version.Major <= 7 Then Args.Add("-XX:MaxPermSize=512m") '#8286
If McLaunchJavaSelected.Version.Major = 8 Then Args.Add("-XX:+ParallelRefProcEnabled")
If McLaunchJavaSelected.Version.Major >= 12 Then Args.Add("-XX:MinHeapFreeRatio=25") '需要比 G1NewSizePercent 大一点
If McLaunchJavaSelected.Version.Major >= 12 Then Args.Add("-XX:MaxHeapFreeRatio=40") '需要比 MinHeapFreeRatio 大一些
ElseIf UseG1GC Then
'Mojang G1GC
Args.Add("-XX:+UseG1GC")
@@ -1510,11 +1346,11 @@ NextInstance:
Args.Add("-XX:G1ReservePercent=20")
Args.Add("-XX:G1HeapRegionSize=32M")
Args.Add("-XX:MaxGCPauseMillis=50")
If McLaunchJavaSelected.MajorVersion <= 7 Then Args.Add("-XX:MaxPermSize=512m") '#8286
If McLaunchJavaSelected.Version.Major <= 7 Then Args.Add("-XX:MaxPermSize=512m") '#8286
Else
'ZGC
Args.Add("-XX:+UseZGC")
If McLaunchJavaSelected.MajorVersion = 21 OrElse McLaunchJavaSelected.MajorVersion = 22 Then Args.Add("-XX:+ZGenerational") 'Java 23 起默认启用分代 ZGC，不需要再添加参数
If McLaunchJavaSelected.Version.Major = 21 OrElse McLaunchJavaSelected.Version.Major = 22 Then Args.Add("-XX:+ZGenerational") 'Java 23 起默认启用分代 ZGC，不需要再添加参数
End If
End If
@@ -1526,9 +1362,9 @@ NextInstance:
Args.Add("-Dlog4j2.formatMsgNoLookups=true")
'编码（#4700、#5892、#5909）
If McLaunchJavaSelected.MajorVersion > 8 AndAlso Not Args.Any(Function(a) a.StartsWithF("-Dstdout.encoding=")) Then Args.Add("-Dstdout.encoding=UTF-8")
If McLaunchJavaSelected.MajorVersion > 8 AndAlso Not Args.Any(Function(a) a.StartsWithF("-Dstderr.encoding=")) Then Args.Add("-Dstderr.encoding=UTF-8")
If McLaunchJavaSelected.MajorVersion >= 18 AndAlso Not Args.Any(Function(a) a.StartsWithF("-Dfile.encoding=")) Then Args.Add("-Dfile.encoding=COMPAT") 'Dfile.encoding 需要放在 Dstdout.encoding 后面（#6934）
If McLaunchJavaSelected.Version.Major > 8 AndAlso Not Args.Any(Function(a) a.StartsWithF("-Dstdout.encoding=")) Then Args.Add("-Dstdout.encoding=UTF-8")
If McLaunchJavaSelected.Version.Major > 8 AndAlso Not Args.Any(Function(a) a.StartsWithF("-Dstderr.encoding=")) Then Args.Add("-Dstderr.encoding=UTF-8")
If McLaunchJavaSelected.Version.Major >= 18 AndAlso Not Args.Any(Function(a) a.StartsWithF("-Dfile.encoding=")) Then Args.Add("-Dfile.encoding=COMPAT") 'Dfile.encoding 需要放在 Dstdout.encoding 后面（#6934）
'为 JLW 添加 -jar，它必须放在最后
If UseJLW Then
@@ -1597,7 +1433,9 @@ NextInstance:
McLaunchLog("发现错误的 OptiFineForge TweakClass，目前的游戏参数：" & Arg)
Arg = Arg.Replace(" --tweakClass optifine.OptiFineTweaker", "") & " --tweakClass optifine.OptiFineForgeTweaker"
Try
FileUtils.Write(McInstanceSelected.GetJsonPath(), FileUtils.ReadAsString(McInstanceSelected.GetJsonPath()).Replace("optifine.OptiFineTweaker", "optifine.OptiFineForgeTweaker"))
FileUtils.Write(
McInstanceSelected.GetJsonPath(),
FileUtils.ReadAsString(McInstanceSelected.GetJsonPath()).Replace("optifine.OptiFineTweaker", "optifine.OptiFineForgeTweaker"))
Catch ex As Exception
Logger.Warn(ex, "替换 OptiFineForge TweakClass 失败")
End Try
@@ -1690,9 +1528,9 @@ NextInstance:
TargetSize = New Size(854, 480)
End Select
If McInstanceSelected.Version.Vanilla.Major <= 12 AndAlso
McLaunchJavaSelected.MajorVersion <= 8 AndAlso McLaunchJavaSelected.Version.Revision >= 200 AndAlso McLaunchJavaSelected.Version.Revision <= 321 AndAlso
McLaunchJavaSelected.Version >= New Version(8, 0, 200) AndAlso McLaunchJavaSelected.Version <= New Version(8, 0, 321) AndAlso
Not McInstanceSelected.Version.HasOptiFine AndAlso Not McInstanceSelected.Version.HasForge Then '修复 1.12.2- 下 JRE 8u200~321 下窗口大小为设置大小的 DPI% 倍（#3463）
McLaunchLog($"已应用窗口大小过大修复（{McLaunchJavaSelected.Version.Revision}）")
McLaunchLog($"已应用窗口大小过大修复（Java 版本：{McLaunchJavaSelected.Version}）")
TargetSize.Width /= DPI / 96
TargetSize.Height /= DPI / 96
End If
@@ -1843,7 +1681,7 @@ NextInstance:
Next
'删除多余文件
For Each FileName As String In DirectoryUtils.GetFiles(Target, True)
For Each FileName As String In DirectoryUtils.EnumerateFiles(Target)
If ExistFiles.Contains(FileName) Then Continue For
Try
McLaunchLog("删除：" & FileName)
@@ -1862,7 +1700,7 @@ NextInstance:
Private Function GetNativesFolder() As String
Dim Result As String = PathUtils.AddSlashSuffix(PathUtils.ToShortPath(McInstanceSelected.PathVersion)) & McInstanceSelected.Name & "-natives\"
If Not (IsGBKEncoding OrElse Result.IsAsciiOnly()) Then
Result = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\bin\natives\"
Result = Paths.AppData & ".minecraft\bin\natives\"
If Not Result.IsAsciiOnly() Then
Result = OsDrive & "ProgramData\PCL\natives\"
End If
@@ -1880,15 +1718,15 @@ NextInstance:
'使用高性能显卡
If Settings.Get(Of Boolean)("LaunchAdvanceGraphicCard") Then
Try
SetGPUPreference(McLaunchJavaSelected.PathJava)
SetGPUPreference(McLaunchJavaSelected.JavaExePath)
SetGPUPreference(PathExe)
Catch ex As Exception
If SystemUtils.HasAdminRole() Then
If WindowsUtils.HasAdminRole() Then
Logger.Warn(ex, "直接调整显卡设置失败")
Else
Logger.Warn(ex, "直接调整显卡设置失败，将以管理员权限重启 PCL 再次尝试")
Try
If RunAsAdmin($"--gpu ""{McLaunchJavaSelected.PathJava}""") = ProcessReturnValues.TaskDone Then
If RunAsAdmin($"--gpu ""{McLaunchJavaSelected.JavaExePath}""") = ProcessReturnValues.TaskDone Then
McLaunchLog("以管理员权限重启 PCL 并调整显卡设置成功")
Else
Throw New Exception("调整过程中出现异常")
@@ -1924,9 +1762,9 @@ NextInstance:
""profile"": ""66666555554444433333222221111100""
}
}"
Dim ReplaceJson As JObject = GetJson(ReplaceJsonString)
Dim ReplaceJson As JObject = (ReplaceJsonString).DeserializeJson()
'更新文件
Dim Profiles As JObject = GetJson(FileUtils.ReadAsString(McFolderSelected & "launcher_profiles.json"))
Dim Profiles As JObject = FileUtils.ReadAsJson(McFolderSelected & "launcher_profiles.json")
Profiles.Merge(ReplaceJson)
FileUtils.Write(McFolderSelected & "launcher_profiles.json", Profiles.ToString, encoding:=Encoding.GetEncoding("GB18030"))
McLaunchLog("已更新 launcher_profiles.json")
@@ -1954,9 +1792,9 @@ NextInstance:
""profile"": ""66666555554444433333222221111100""
}
}"
Dim ReplaceJson As JObject = GetJson(ReplaceJsonString)
Dim ReplaceJson As JObject = ReplaceJsonString.DeserializeJson()
'更新文件
Dim Profiles As JObject = GetJson(FileUtils.ReadAsString(McFolderSelected & "launcher_profiles.json"))
Dim Profiles As JObject = FileUtils.ReadAsJson(McFolderSelected & "launcher_profiles.json")
Profiles.Merge(ReplaceJson)
FileUtils.Write(McFolderSelected & "launcher_profiles.json", Profiles.ToString, encoding:=Encoding.GetEncoding("GB18030"))
McLaunchLog("已在删除后更新 launcher_profiles.json")
@@ -2026,7 +1864,7 @@ NextInstance:
Try
Dim ZipFileAddress As String = McInstanceSelected.PathIndie & "resourcepacks\PCL2 Skin.zip"
Dim NewTypeSetup As Boolean = McInstanceSelected.Version.Vanilla.Major >= 13 OrElse McInstanceSelected.Version.Vanilla.Major < 6
If McLoginLoader.Input.Type = McLoginType.Legacy AndAlso Settings.Get(Of Integer)("LaunchSkinType") = 4 AndAlso FileUtils.Exists(PathAppdata & "CustomSkin.png") Then
If McLoginLoader.Input.Type = McLoginType.Legacy AndAlso Settings.Get(Of Integer)("LaunchSkinType") = 4 AndAlso FileUtils.Exists(Paths.AppDataThenName & "CustomSkin.png") Then
Dim MetaFileAddress As String = PathTemp & "pack.mcmeta"
Dim PackPicAddress As String = PathTemp & "pack.png"
Dim PackFormat As Integer
@@ -2076,12 +1914,12 @@ NextInstance:
Dim Bit As New MyBitmap(PathImage & "Heads/Logo.png")
Bit.Save(PackPicAddress)
FileUtils.Write(MetaFileAddress, "{""pack"":{""pack_format"":" & PackFormat & ",""description"":""PCL 自定义离线皮肤资源包""}}")
Dim Skin As New MyBitmap(PathAppdata & "CustomSkin.png")
Dim Skin As New MyBitmap(Paths.AppDataThenName & "CustomSkin.png")
If (McInstanceSelected.Version.Vanilla.Major = 6 OrElse McInstanceSelected.Version.Vanilla.Major = 7) AndAlso Skin.Pic.Height = 64 Then
McLaunchLog("该 Minecraft 版本不支持双层皮肤，已进行裁剪")
Skin = Skin.Clip(0, 0, 64, 32)
End If
Skin.Save(PathExeFolder & "PCL\CustomSkin_Cliped.png")
Skin.Save(Paths.Base & "PCL\CustomSkin_Cliped.png")
'构建压缩文件
Dim FilesToCompress As New Dictionary(Of String, String) From {
{"pack.mcmeta", MetaFileAddress}, {"pack.png", PackPicAddress}}
@@ -2090,15 +1928,15 @@ NextInstance:
For Each SkinName In {"alex", "ari", "efe", "kai", "makena", "noor", "steve", "sunny", "zuri"}
FilesToCompress.Add(
$"assets/minecraft/textures/entity/player/{If(Settings.Get(Of Boolean)("LaunchSkinSlim"), "slim", "wide")}/{SkinName}.png",
PathExeFolder & "PCL\CustomSkin_Cliped.png")
Paths.Base & "PCL\CustomSkin_Cliped.png")
Next
Else
FilesToCompress.Add(
$"assets/minecraft/textures/entity/{If(Settings.Get(Of Boolean)("LaunchSkinSlim"), "alex.png", "steve.png")}",
PathExeFolder & "PCL\CustomSkin_Cliped.png")
Paths.Base & "PCL\CustomSkin_Cliped.png")
End If
FileUtils.CreateZipFromFiles(ZipFileAddress, FilesToCompress)
FileUtils.Delete(PathExeFolder & "PCL\CustomSkin_Cliped.png")
FileUtils.Delete(Paths.Base & "PCL\CustomSkin_Cliped.png")
'更改设置文件
IniClearCache(SetupFileAddress)
Dim EnabledResourcePack As String = ReadIni(SetupFileAddress, "resourcePacks", "[]").TrimStart("[").TrimEnd("]")
@@ -2159,25 +1997,25 @@ IgnoreCustomSkin:
'输出 bat
Try
Dim CmdString As String =
$"{If(McLaunchJavaSelected.MajorVersion > 8, "chcp 65001>nul" & vbCrLf, "")}" &
$"{If(McLaunchJavaSelected.Version.Major > 8, "chcp 65001>nul" & vbCrLf, "")}" &
"@echo off" & vbCrLf &
$"title 启动 - {McInstanceSelected.Name}" & vbCrLf &
"echo 游戏正在启动，请稍候。" & vbCrLf &
$"cd /D ""{PathUtils.ToShortPath(McInstanceSelected.PathIndie)}""" & vbCrLf &
CustomCommandGlobal & vbCrLf &
CustomCommandVersion & vbCrLf &
$"""{McLaunchJavaSelected.PathJava}"" {McLaunchArgument}" & vbCrLf &
$"""{McLaunchJavaSelected.JavaExePath}"" {McLaunchArgument}" & vbCrLf &
"echo 游戏已退出。" & vbCrLf &
"pause"
FileUtils.Write(
filePath:=If(CurrentLaunchOptions.SaveBatch, PathExeFolder & "PCL\LatestLaunch.bat"),
filePath:=If(CurrentLaunchOptions.SaveBatch, Paths.Base & "PCL\LatestLaunch.bat"),
text:=FilterAccessToken(CmdString, "F").Replace("%", "%%"),
encoding:=If(McLaunchJavaSelected.MajorVersion > 8, Encoding.UTF8, Encoding.Default))
encoding:=If(McLaunchJavaSelected.Version.Major > 8, Encoding.UTF8, Encoding.Default))
If CurrentLaunchOptions.SaveBatch IsNot Nothing Then
McLaunchLog("导出启动脚本完成，强制结束启动过程")
InterruptHint = "导出启动脚本成功！"
CanceledHint = "导出启动脚本成功！"
OpenExplorer(CurrentLaunchOptions.SaveBatch)
Loader.Parent.Interrupt()
Loader.Parent.Cancel()
Return '导出脚本完成
End If
Catch ex As Exception
@@ -2198,14 +2036,14 @@ IgnoreCustomSkin:
.CreateNoWindow = True
})
If Settings.Get(Of Boolean)("LaunchAdvanceRunWait") Then
Do Until CustomProcess.HasExited OrElse Loader.IsInterrupted
Do Until CustomProcess.HasExited OrElse Loader.IsCanceled
Thread.Sleep(10)
Loop
End If
Catch ex As Exception
Logger.Error(ex, "执行全局自定义命令失败", LogBehavior.Toast)
Finally
If CustomProcess IsNot Nothing AndAlso Not CustomProcess.HasExited AndAlso Loader.IsInterrupted Then
If CustomProcess IsNot Nothing AndAlso Not CustomProcess.HasExited AndAlso Loader.IsCanceled Then
McLaunchLog("由于取消启动，已强制结束自定义命令 CMD 进程") '#1183
CustomProcess.Kill()
End If
@@ -2223,14 +2061,14 @@ IgnoreCustomSkin:
.CreateNoWindow = True
})
If Settings.Get(Of Boolean)("VersionAdvanceRunWait", Instance:=McInstanceSelected) Then
Do Until CustomProcess.HasExited OrElse Loader.IsInterrupted
Do Until CustomProcess.HasExited OrElse Loader.IsCanceled
Thread.Sleep(10)
Loop
End If
Catch ex As Exception
Logger.Error(ex, "执行版本自定义命令失败", LogBehavior.Toast)
Finally
If CustomProcess IsNot Nothing AndAlso Not CustomProcess.HasExited AndAlso Loader.IsInterrupted Then
If CustomProcess IsNot Nothing AndAlso Not CustomProcess.HasExited AndAlso Loader.IsCanceled Then
McLaunchLog("由于取消启动，已强制结束自定义命令 CMD 进程") '#1183
CustomProcess.Kill()
End If
@@ -2241,13 +2079,13 @@ IgnoreCustomSkin:
Private Sub McLaunchRun(Loader As LoaderTask(Of Integer, Process))
'启动信息
Dim StartInfo As New ProcessStartInfo(McLaunchJavaSelected.PathJava) '使用 javaw.exe 会导致 #6263
Dim StartInfo As New ProcessStartInfo(McLaunchJavaSelected.JavaExePath) '使用 javaw.exe 会导致 #6263
'设置环境变量
Dim PathEnv As String = StartInfo.EnvironmentVariables("Path")
Dim Paths As New List(Of String)
If Not String.IsNullOrEmpty(PathEnv) Then Paths.AddRange(PathEnv.Split(";"))
Paths.Add(PathUtils.ToShortPath(McLaunchJavaSelected.PathFolder))
Paths.Add(PathUtils.ToShortPath(McLaunchJavaSelected.Folder))
StartInfo.EnvironmentVariables("Path") = Paths.Distinct.Join(";"c)
StartInfo.EnvironmentVariables("appdata") = PathUtils.ToShortPath(McFolderSelected)
@@ -2261,8 +2099,8 @@ IgnoreCustomSkin:
'开始进程
Dim GameProcess = StartProcess(StartInfo)
McLaunchLog("已启动游戏进程：" & McLaunchJavaSelected.PathJava)
If Loader.IsInterrupted Then
McLaunchLog("已启动游戏进程：" & McLaunchJavaSelected.JavaExePath)
If Loader.IsCanceled Then
McLaunchLog("由于取消启动，已强制结束游戏进程") '#1631
GameProcess.Kill()
Return
@@ -2294,13 +2132,12 @@ IgnoreCustomSkin:
McLaunchLog($"游戏版本：{McInstanceSelected.VersionDisplayName}（{McInstanceSelected.Version.Vanilla}，Drop {McInstanceSelected.Version.Drop}{If(McInstanceSelected.Version.Reliable, "", "，无法完全确定")}）")
McLaunchLog("资源版本：" & McAssetsGetIndexName(McInstanceSelected))
McLaunchLog("版本继承：" & If(McInstanceSelected.InheritName = "", "无", McInstanceSelected.InheritName))
McLaunchLog("分配的内存：" & PageInstanceSetup.GetRam(McInstanceSelected, Not McLaunchJavaSelected.Is64Bit) & " GB（" & Math.Round(PageInstanceSetup.GetRam(McInstanceSelected, Not McLaunchJavaSelected.Is64Bit) * 1024) & " MB）")
McLaunchLog("分配的内存：" & PageInstanceSetup.GetRam(McInstanceSelected) & " GB（" & Math.Round(PageInstanceSetup.GetRam(McInstanceSelected) * 1024) & " MB）")
McLaunchLog("MC 文件夹：" & McFolderSelected)
McLaunchLog("版本文件夹：" & McInstanceSelected.PathVersion)
McLaunchLog("版本隔离：" & (McInstanceSelected.PathIndie = McInstanceSelected.PathVersion))
McLaunchLog("HMCL 格式：" & McInstanceSelected.IsHmclFormatJson)
McLaunchLog("Java 信息：" & If(McLaunchJavaSelected IsNot Nothing, McLaunchJavaSelected.ToString, "无可用 Java"))
McLaunchLog("环境变量：" & If(McLaunchJavaSelected IsNot Nothing, If(McLaunchJavaSelected.HasEnvironment, "已设置", "未设置"), "未设置"))
McLaunchLog("Natives 文件夹：" & GetNativesFolder())
McLaunchLog("")
McLaunchLog("~ 登录参数 ~")
@@ -2325,7 +2162,7 @@ IgnoreCustomSkin:
Thread.Sleep(100)
Loop
If Watcher.State = Watcher.MinecraftState.Crashed Then
Throw New Exception("$$")
Throw New OperationCanceledException
End If
End Sub
Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb
+43 -45
View File
@@ -1,4 +1,4 @@
Public Module ModMinecraft
Public Module ModMinecraft
#Region "文件夹"
@@ -16,9 +16,9 @@
End Property
Private Sub SetMcFolder(Value As String) '等同 McFolderSelected.Set
If _McFolderSelected = Value Then Return
_McFolderSelected = Value.Replace("$", PathExeFolder)
_McFolderSelected = Value.Replace("$", Paths.Base)
_McFolderSelected = PathUtils.AddSlashSuffix(PathUtils.ForCompare(_McFolderSelected))
Settings.Set("LaunchFolderSelect", Value.Replace(PathExeFolder, "$"))
Settings.Set("LaunchFolderSelect", Value.Replace(Paths.Base, "$"))
Logger.Info($"当前选择的 Minecraft 文件夹：{_McFolderSelected}")
End Sub
Private _McFolderSelected As String
@@ -64,8 +64,8 @@
'扫描当前文件夹
Try
If DirectoryUtils.Exists(PathExeFolder & "versions\") Then CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = PathExeFolder, .Type = McFolder.Types.Vanilla})
For Each Folder As DirectoryInfo In DirectoryUtils.GetInfo(PathExeFolder).GetDirectories
If DirectoryUtils.Exists(Paths.Base & "versions\") Then CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = Paths.Base, .Type = McFolder.Types.Vanilla})
For Each Folder As DirectoryInfo In DirectoryUtils.GetInfo(Paths.Base).GetDirectories
If DirectoryUtils.Exists(Folder.FullName & "versions\") OrElse Folder.Name = ".minecraft" Then
CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = PathUtils.AddSlashSuffix(PathUtils.ForCompare(Folder.FullName)), .Type = McFolder.Types.Vanilla})
End If
@@ -75,7 +75,7 @@
End Try
'扫描官启文件夹
Dim MojangPath As String = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\"
Dim MojangPath As String = Paths.AppData & ".minecraft\"
If (Not CacheMcFolderList.Any OrElse MojangPath <> CacheMcFolderList(0).Location) AndAlso '当前文件夹不是官启文件夹
DirectoryUtils.Exists(MojangPath & "versions\") Then '具有权限且存在 versions 文件夹
CacheMcFolderList.Add(New McFolder With {.Name = "官方启动器文件夹", .Location = MojangPath, .Type = McFolder.Types.Vanilla})
@@ -123,8 +123,8 @@
'若没有可用文件夹，则创建 .minecraft
If Not CacheMcFolderList.Any() Then
DirectoryUtils.Create(PathExeFolder & ".minecraft\versions\")
CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = PathExeFolder & ".minecraft\", .Type = McFolder.Types.Vanilla})
DirectoryUtils.Create(Paths.Base & ".minecraft\versions\")
CacheMcFolderList.Add(New McFolder With {.Name = "当前文件夹", .Location = Paths.Base & ".minecraft\", .Type = McFolder.Types.Vanilla})
End If
For Each Folder As McFolder In CacheMcFolderList
@@ -463,9 +463,9 @@ VersionSearchFinish:
If Not FileUtils.Exists(JsonPath) Then
'尝试寻找 JSON 文件
JsonPath = Nothing
For Each JsonCandidatePath In DirectoryUtils.GetFiles(PathVersion, True, "*.json")
For Each JsonCandidatePath In DirectoryUtils.EnumerateFiles(PathVersion, searchPattern:="*.json")
Try
Dim JsonCandidate As JObject = GetJson(FileUtils.ReadAsString(JsonCandidatePath))
Dim JsonCandidate As JObject = FileUtils.ReadAsJson(JsonCandidatePath)
If Not JsonCandidate.ContainsKey("mainClass") Then Continue For
If Not JsonCandidate.ContainsKey("type") Then Continue For
If Not JsonCandidate.ContainsKey("id") Then Continue For
@@ -501,12 +501,12 @@ VersionSearchFinish:
If Not FastJsonCheck(_JsonText) Then
If RunInUi() Then
Logger.Warn("版本 JSON 文件为空或有误，由于代码在主线程运行，将不再进行重试")
GetJson(_JsonText) '触发异常
_JsonText.DeserializeJson() '触发异常
Else
Logger.Warn($"版本 JSON 文件为空或有误，将在 2s 后重试读取（{JsonPath}）")
Thread.Sleep(2000)
_JsonText = FileUtils.ReadAsString(JsonPath)
If Not FastJsonCheck(_JsonText) Then GetJson(_JsonText) '触发异常
If Not FastJsonCheck(_JsonText) Then _JsonText.DeserializeJson() '触发异常
End If
End If
End If
@@ -526,7 +526,7 @@ VersionSearchFinish:
If _JsonObject Is Nothing Then
Dim Text As String = JsonText '触发 JsonText 的 Get 事件
Try
_JsonObject = GetJson(Text)
_JsonObject = Text.DeserializeJson()
'转换 HMCL 关键项
If _JsonObject.ContainsKey("patches") AndAlso Not _JsonObject.ContainsKey("time") Then
IsHmclFormatJson = True
@@ -626,7 +626,7 @@ Recheck:
Dim VersionJson As ZipArchiveEntry = JarArchive.GetEntry("version.json")
If VersionJson Is Nothing Then Exit Try
Using VersionJsonStream As New StreamReader(VersionJson.Open)
_JsonVersion = GetJson(VersionJsonStream.ReadToEnd)
_JsonVersion = VersionJsonStream.ReadToEnd().DeserializeJson()
End Using
End Using
Catch ex As Exception
@@ -659,22 +659,23 @@ Recheck:
End Property
Private _InheritName As String = Nothing
Public Sub ResetIniCache()
Public Config As JsonConfigProvider
Public Sub ResetSettingsCache()
IniClearCache(PathIndie & "options.txt")
IniClearCache(PathVersion & "PCL\Setup.ini")
Config.DiscardCache()
For Each Entry In Settings.Entries.Values
If Entry.Source = Settings.Sources.Instance Then Entry.ValueCache.Remove(PathVersion)
Next
End Sub
''' <summary>
''' 从版本名，或版本文件夹的完整路径初始化（不规定是否以 \ 结尾）。
''' 从版本名，或版本文件夹的完整路径初始化。
''' </summary>
Public Sub New(Name As String)
Name = PathUtils.RemoveExtendedPrefix(Name)
PathVersion = If(Name.Contains(":"), "", McFolderSelected & "versions\") & '补全完整路径
Name &
If(Name.EndsWithF("\"), "", "\") '补全右划线
Public Sub New(NameOrFullPath As String)
NameOrFullPath = PathUtils.RemoveExtendedPrefix(NameOrFullPath)
PathVersion = PathUtils.AddSlashSuffix(If(NameOrFullPath.Contains(":"), "", McFolderSelected & "versions\") & NameOrFullPath)
Config = New JsonConfigProvider(Path.Combine(PathVersion, "PCL\config.json"))
End Sub
''' <summary>
@@ -1286,7 +1287,7 @@ ExitDataLoad:
GoTo OnLoaded
End If
'有可用版本
Dim FolderListCheck As Integer = (Versions.MCINSTANCE_CACHE_VERSION & "#" & FolderList.Join("#"c)).GetStableHashCode() Mod (Integer.MaxValue - 1) '根据文件夹名列表生成辨识码
Dim FolderListCheck As Integer = (Versions.McInstanceCacheVersion & "#" & FolderList.Join("#"c)).GetStableHashCode() Mod (Integer.MaxValue - 1) '根据文件夹名列表生成辨识码
If Not McInstanceListForceRefresh AndAlso Val(ReadIni(PathMc & "PCL.ini", "InstanceCache")) = FolderListCheck Then
'可以使用缓存
Dim Result = InitMcInstanceListWithCache(PathMc)
@@ -1307,7 +1308,7 @@ Reload:
'改变当前选择的版本
OnLoaded:
If Loader.IsInterrupted Then Return
If Loader.IsCanceled Then Return
If McInstanceList.Any(Function(v) v.Key <> McInstanceCardType.Error) Then
'尝试读取已储存的选择
Dim SavedSelection As String = ReadIni(PathMc & "PCL.ini", "Version")
@@ -1333,9 +1334,8 @@ OnLoaded:
Logger.Info("未找到可用 Minecraft 版本")
End If
If Settings.Get(Of Boolean)("SystemDebugDelay") Then Thread.Sleep(RandomInteger(200, 3000))
Catch ex As ThreadInterruptedException
Catch ex As Exception
If Loader.IsInterrupted Then Return '#5617
If Loader.IsCanceled OrElse ex.IsCanceled Then Return '#5617
WriteIni(PathMc & "PCL.ini", "InstanceCache", "") '要求下次重新加载
Logger.Error(ex, "加载 .minecraft 版本列表失败")
End Try
@@ -1716,7 +1716,7 @@ OnLoaded:
'处理皮肤地址
Dim SkinValue As String
Try
For Each SkinProperty In GetJson(SkinString)("properties")
For Each SkinProperty In SkinString.DeserializeJson()("properties")
If SkinProperty("name") = "textures" Then
SkinValue = SkinProperty("value")
Exit Try
@@ -1728,7 +1728,7 @@ OnLoaded:
Throw New Exception("皮肤返回值中不包含皮肤数据项，可能是未设置自定义皮肤的用户", ex)
End Try
SkinString = Encoding.UTF8.GetString(Convert.FromBase64String(SkinValue))
Dim SkinJson As JObject = GetJson(SkinString.Lower)
Dim SkinJson As JObject = SkinString.Lower.DeserializeJson()
If SkinJson("textures") Is Nothing OrElse SkinJson("textures")("skin") Is Nothing OrElse SkinJson("textures")("skin")("url") Is Nothing Then
Throw New Exception("用户未设置自定义皮肤")
Else
@@ -1751,7 +1751,6 @@ OnLoaded:
SyncLock McSkinDownloadLock
If Not FileUtils.Exists(FileAddress) Then
NetDownloadByClient(Address, FileAddress & ".PCLDownloading")
FileUtils.Delete(FileAddress)
FileUtils.Move(FileAddress & ".PCLDownloading", FileAddress)
Logger.Info($"皮肤下载成功：{FileAddress}")
End If
@@ -1835,7 +1834,7 @@ OnLoaded:
Public OriginalName As String
Public Overrides Function ToString() As String
Return If(IsNatives, "[Native] ", "") & FormatFileSize(Size) & " | " & LocalPath
Return If(IsNatives, "[Native] ", "") & StringUtils.FormatByteSize(Size) & " | " & LocalPath
End Function
End Class
@@ -1865,7 +1864,7 @@ OnLoaded:
End If
End If
If Rule("os")("arch") IsNot Nothing Then '操作系统架构
IsRightRule = IsRightRule AndAlso ((Rule("os")("arch").ToString = "x86") = Is32BitSystem)
IsRightRule = IsRightRule AndAlso Rule("os")("arch").ToString <> "x86" AndAlso Not Rule("os")("arch").Contains("arm")
End If
End If
If Not IsNothing(Rule("features")) Then '标签
@@ -2078,11 +2077,11 @@ OnLoaded:
Try
'测试链接：https://auth.mc-user.com:233/00000000000000000000000000000000/
Logger.Info("开始获取统一通行证下载信息")
Dim DownloadInfo = GetJson(NetRequestByClientRetry("https://auth.mc-user.com:233/" & Settings.Get(Of String)("VersionServerNide", Instance:=Instance), RequireJson:=True))
Dim DownloadInfo As JObject = NetRequestByClientRetry("https://auth.mc-user.com:233/" & Settings.Get(Of String)("VersionServerNide", Instance:=Instance), RequireJson:=True).DeserializeJson()
Result.Add(New NetFile(
Urls:={"https://login.mc-user.com:233/index/jar"},
LocalPath:=TargetFile,
Checker:=New FileChecker(Hash:=DownloadInfo("jarHash").ToString)))
Checker:=New FileChecker With {.Hash = DownloadInfo("jarHash").ToString}))
Catch ex As Exception
If FileUtils.Exists(TargetFile) Then
Logger.Warn(ex, "获取统一通行证下载信息失败")
@@ -2097,15 +2096,15 @@ OnLoaded:
Dim TargetFile = PathPure & "authlib-injector.jar"
Try
Logger.Info("开始获取 Authlib-Injector 下载信息")
Dim DownloadInfo = GetJson(NetRequestByClientRetry(
Dim DownloadInfo As JObject = NetRequestByClientRetry(
"https://authlib-injector.yushi.moe/artifact/latest.json",
BackupUrl:="https://bmclapi2.bangbang93.com/mirrors/authlib-injector/artifact/latest.json", RequireJson:=True))
BackupUrl:="https://bmclapi2.bangbang93.com/mirrors/authlib-injector/artifact/latest.json", RequireJson:=True).DeserializeJson()
Dim DownloadAddress As String = DownloadInfo("download_url").ToString.
Replace("bmclapi2.bangbang93.com/mirrors/authlib-injector", "authlib-injector.yushi.moe")
Result.Add(New NetFile({
DownloadAddress,
DownloadAddress.Replace("authlib-injector.yushi.moe", "bmclapi2.bangbang93.com/mirrors/authlib-injector")
}, TargetFile, New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString)))
}, TargetFile, New FileChecker With {.Hash = DownloadInfo("checksums")("sha256").ToString}))
Catch ex As Exception
If FileUtils.Exists(TargetFile) Then
Logger.Warn(ex, "获取 Authlib-Injector 下载信息失败")
@@ -2144,7 +2143,7 @@ OnLoaded:
If Token.Name.ContainsIgnoreCase("labymod") Then
Checker = New FileChecker '不检查 LabyMod 的文件，它们提供的文件校验信息是错的（#3225）
Else
Checker = New FileChecker(ActualSize:=If(Token.Size = 0, -1, Token.Size), Hash:=Token.SHA1)
Checker = New FileChecker With {.ActualSize = If(Token.Size = 0, -1, Token.Size), .Hash = Token.SHA1}
End If
'URL
Dim Urls As New List(Of String)
@@ -2238,16 +2237,16 @@ OnLoaded:
'返回 assets 文件名会由于没有下载地址导致全局失败
'If AssetsName IsNot Nothing AndAlso AssetsName <> "legacy" Then
' Log("[Minecraft] 无法获取资源文件索引下载地址，使用 assets 项提供的资源文件名：" & AssetsName)
' Return GetJson("{""id"": """ & AssetsName & """}")
' Return ("{""id"": """ & AssetsName & """}").DeserializeJson()
'Else
Logger.Info("无法获取资源文件索引下载地址，使用默认的 legacy 下载地址")
Return GetJson("{
Return "{
""id"": ""legacy"",
""sha1"": ""c0fd82e8ce9fbc93119e40d96d5a4e62cfa3f729"",
""size"": 134284,
""url"": ""https://launchermeta.mojang.com/mc-staging/assets/legacy/c0fd82e8ce9fbc93119e40d96d5a4e62cfa3f729/legacy.json"",
""totalSize"": 111220701
}")
}".DeserializeJson()
'End If
Else
Throw New Exception("该版本不存在资源文件索引信息")
@@ -2294,7 +2293,7 @@ OnLoaded:
Public Hash As String
Public Overrides Function ToString() As String
Return FormatFileSize(Size) & " | " & LocalPath
Return StringUtils.FormatByteSize(Size) & " | " & LocalPath
End Function
End Structure
''' <summary>
@@ -2307,7 +2306,7 @@ OnLoaded:
'初始化
If Not FileUtils.Exists($"{McFolderSelected}assets\indexes\{IndexName}.json") Then Throw New FileNotFoundException("未找到 Asset Index", McFolderSelected & "assets\indexes\" & IndexName & ".json")
Dim Result As New List(Of McAssetsToken)
Dim Json As JObject = GetJson(FileUtils.ReadAsString($"{McFolderSelected}assets\indexes\{IndexName}.json"))
Dim Json As JObject = FileUtils.ReadAsJson($"{McFolderSelected}assets\indexes\{IndexName}.json")
'读取列表
For Each File As JProperty In Json("objects").Children
@@ -2347,8 +2346,7 @@ OnLoaded:
Select(Function(Token As McAssetsToken) New NetFile(
DlSourceAssetsGet($"https://resources.download.minecraft.net/{Left(Token.Hash, 2)}/{Token.Hash}"),
LocalPath:=Token.LocalPath,
Checker:=New FileChecker(ActualSize:=If(Token.Size = 0, -1, Token.Size),
Hash:=Token.Hash))).ToList
Checker:=New FileChecker With {.ActualSize = If(Token.Size = 0, -1, Token.Size), .Hash = Token.Hash})).ToList
End If
'如果不检查 Hash，则立即处理
Dim Result As New List(Of NetFile)
@@ -2365,7 +2363,7 @@ OnLoaded:
Dim File = FileUtils.GetInfo(Token.LocalPath)
If File.Exists AndAlso (Token.Size = 0 OrElse Token.Size = File.Length) Then Continue For
'文件不存在，添加下载
Result.Add(New NetFile(DlSourceAssetsGet($"https://resources.download.minecraft.net/{Left(Token.Hash, 2)}/{Token.Hash}"), Token.LocalPath, New FileChecker(ActualSize:=If(Token.Size = 0, -1, Token.Size), Hash:=Token.Hash)))
Result.Add(New NetFile(DlSourceAssetsGet($"https://resources.download.minecraft.net/{Left(Token.Hash, 2)}/{Token.Hash}"), Token.LocalPath, New FileChecker With {.ActualSize = If(Token.Size = 0, -1, Token.Size), .Hash = Token.Hash}))
Next
Catch ex As Exception
Logger.Warn(ex, "获取版本缺失的资源文件下载列表失败")
@@ -2394,7 +2392,7 @@ OnLoaded:
If Version Is Nothing Then Return
Dim Time As Date = Version("releaseTime")
Dim MsgBoxText As String = $"新版本：{VersionName}{vbCrLf}" &
If((Date.Now - Time).TotalDays > 1, "更新时间：" & Time.ToString, "更新于：" & GetTimeSpanString(Time - Date.Now, False))
If((Date.Now - Time).TotalDays > 1, "更新时间：" & Time.ToString, "更新于：" & StringUtils.FormatTimeSpan(Time - Date.Now, False))
Dim MsgResult = MyMsgBox(MsgBoxText, "Minecraft 更新提示", "确定", "下载", If((Date.Now - Time).TotalHours > 3, "更新日志", ""),
Button3Action:=Sub() McUpdateLogShow(Version))
'弹窗结果
Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb
+51 -54
View File
@@ -1,4 +1,7 @@
Public Module ModModpack
Imports System.Collections.ObjectModel
Imports System.Text.RegularExpressions
Public Module ModModpack
'触发整合包安装的外部接口
''' <summary>
@@ -11,8 +14,8 @@
Sub()
Try
ModpackInstall(File)
Catch ex As CancelledException
Catch ex As Exception
ex.ThrowIfCanceled()
Logger.Error(ex, "手动安装整合包失败", LogBehavior.Alert)
End Try
End Sub)
@@ -21,7 +24,6 @@
''' 构建并启动安装给定的整合包文件的加载器，并返回该加载器。若失败则抛出异常。
''' 必须在工作线程执行。
''' </summary>
''' <exception cref="CancelledException" />
Public Function ModpackInstall(File As String, Optional InstanceName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
Logger.Info($"整合包安装请求：{If(File, "null")}")
Dim Archive As ZipArchive = Nothing
@@ -29,7 +31,7 @@
Try
'字符校验
Dim TargetFolder As String = $"{McFolderSelected}versions\{InstanceName}\"
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("游戏路径中不能含有感叹号或分号：" & TargetFolder, HintType.Red) : Throw New CancelledException
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("游戏路径中不能含有感叹号或分号：" & TargetFolder, HintType.Red) : Throw New OperationCanceledException
'获取整合包种类与关键 Json
Dim PackType As Integer = -1
Try
@@ -39,7 +41,7 @@
If Archive.GetEntry("mmc-pack.json") IsNot Nothing Then PackType = 2 : Exit Try 'MMC 整合包（优先于 manifest.json 判断，#4194）
If Archive.GetEntry("modrinth.index.json") IsNot Nothing Then PackType = 4 : Exit Try 'Modrinth 整合包
If Archive.GetEntry("manifest.json") IsNot Nothing Then
Dim Json As JObject = GetJson(Archive.GetEntry("manifest.json").Open().ReadString(Encoding.UTF8))
Dim Json As JObject = Archive.GetEntry("manifest.json").Open().ReadString(Encoding.UTF8).DeserializeJson()
If Json("addons") Is Nothing Then
PackType = 0 : Exit Try 'CurseForge 整合包
Else
@@ -59,7 +61,7 @@
If PathSplits(1) = "mmc-pack.json" Then PackType = 2 : Exit Try 'MMC 整合包（优先于 manifest.json 判断，#4194）
If PathSplits(1) = "modrinth.index.json" Then PackType = 4 : Exit Try 'Modrinth 整合包
If PathSplits(1) = "manifest.json" Then
Dim Json As JObject = GetJson(Entry.Open().ReadString(Encoding.UTF8))
Dim Json As JObject = Entry.Open().ReadString(Encoding.UTF8).DeserializeJson()
If Json("addons") Is Nothing Then
PackType = 0 : Exit Try 'CurseForge 整合包
Else
@@ -163,22 +165,21 @@ Retry:
''' 弹窗提示整合包中存在不兼容的加载器。
''' 如果取消，则抛出 CancelledException。
''' </summary>
''' <exception cref="CancelledException" />
Private Sub NotifyIncompatibleLoader(LoaderName As String)
If MyMsgBox($"整合包中存在不兼容的加载器：{LoaderName}{vbCrLf}如果你知道如何手动安装它，可以先选择跳过，然后在整合包下载结束后手动安装。",
"不兼容的加载器", "取消", $"不安装 {LoaderName} 并继续") = 1 Then Throw New CancelledException
"不兼容的加载器", "取消", $"不安装 {LoaderName} 并继续") = 1 Then Throw New OperationCanceledException
End Sub
#Region "不同类型整合包的安装方法"
'CurseForge
Private Function InstallPackCurseForge(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String,
Private Function InstallPackCurseForge(FileAddress As String, Archive As ZipArchive, ArchiveBaseFolder As String,
Optional InstanceName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
'读取 Json 文件
Dim Json As JObject
Try
Json = GetJson(Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open().ReadString)
Json = Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open().ReadString().DeserializeJson()
Catch ex As Exception
Throw New Exception("CurseForge 整合包安装信息存在问题", ex)
End Try
@@ -189,8 +190,8 @@ Retry:
InstanceName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Throw New OperationCanceledException
End If
'获取 Mod API 版本信息
@@ -272,9 +273,9 @@ Retry:
MissingDesc.Add($"{Project.TranslatedName} (文件 ID {Missing.FileId})")
End If
Next
If MyMsgBox($"未找到该整合包所需的以下内容，它们可能已被原作者删除：{vbCrLf}- {MissingDesc.Join(vbCrLf & "- ")}{vbCrLf}{vbCrLf}是否继续安装？缺失这些内容可能导致整合包出现异常！",
If MyMsgBox($"未找到该整合包所需的以下内容，它们可能已被原作者删除：{vbCrLf}- {MissingDesc.Join(vbCrLf + "- ")}{vbCrLf}{vbCrLf}是否继续安装？缺失这些内容可能导致整合包出现异常！",
"整合包内容缺失", "继续", "取消", IsWarn:=True) = 2 Then
Task.Interrupt()
Task.Cancel()
End If
End Sub) With {.ProgressWeight = ModList.Count / 10}) '每 10 Mod 需要 1s
'构造 NetFile
@@ -364,7 +365,7 @@ Retry:
Dim LoaderName As String = "CurseForge 整合包安装：" & InstanceName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中！", HintType.Red)
Throw New CancelledException
Throw New OperationCanceledException
End If
'启动
@@ -377,12 +378,12 @@ Retry:
End Function
'Modrinth
Private Function InstallPackModrinth(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional InstanceName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
Private Function InstallPackModrinth(FileAddress As String, Archive As ZipArchive, ArchiveBaseFolder As String, Optional InstanceName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
'读取 Json 文件
Dim Json As JObject
Try
Json = GetJson(Archive.GetEntry(ArchiveBaseFolder & "modrinth.index.json").Open().ReadString)
Json = Archive.GetEntry(ArchiveBaseFolder & "modrinth.index.json").Open().ReadString().DeserializeJson()
Catch ex As Exception
Throw New Exception("Modrinth 整合包安装信息存在问题", ex)
End Try
@@ -412,8 +413,8 @@ Retry:
InstanceName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Throw New OperationCanceledException
End If
'解压
Dim InstallTemp As String = RequestTaskTempFolder()
@@ -452,10 +453,10 @@ Retry:
Dim TargetPath As String = $"{McFolderSelected}versions\{InstanceName}\{File("path")}"
If Not Path.GetFullPath(TargetPath).StartsWithF(Path.GetFullPath($"{McFolderSelected}versions\{InstanceName}\")) Then
MyMsgBox($"整合包的文件路径超出了版本文件夹，请向整合包作者反馈此问题！{vbCrLf}目标：{Path.GetFullPath(TargetPath)}{vbCrLf}错误的文件：{TargetPath}", "文件路径校验失败", IsWarn:=True)
Throw New CancelledException
Throw New OperationCanceledException
End If
FileList.Add(New NetFile(Urls, TargetPath,
New FileChecker(ActualSize:=File("fileSize").ToObject(Of Long), Hash:=File("hashes")("sha1").ToString), True))
New FileChecker With {.ActualSize = File("fileSize").ToObject(Of Long), .Hash = File("hashes")("sha1").ToString}, True))
Next
If FileList.Any Then
InstallLoaders.Add(New LoaderDownload("下载额外文件", FileList) With {.ProgressWeight = FileList.Count * 1.5}) '每个 Mod 需要 1.5s
@@ -502,7 +503,7 @@ Retry:
Dim LoaderName As String = $"Modrinth 整合包安装：{InstanceName} "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中！", HintType.Red)
Throw New CancelledException
Throw New OperationCanceledException
End If
'启动
@@ -515,11 +516,11 @@ Retry:
End Function
'HMCL
Private Function InstallPackHMCL(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
Private Function InstallPackHMCL(FileAddress As String, Archive As ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
'读取 Json 文件
Dim Json As JObject
Try
Json = GetJson(Archive.GetEntry(ArchiveBaseFolder & "modpack.json").Open().ReadString(Encoding.UTF8))
Json = Archive.GetEntry(ArchiveBaseFolder & "modpack.json").Open().ReadString(Encoding.UTF8).DeserializeJson()
Catch ex As Exception
Throw New Exception("HMCL 整合包安装信息存在问题", ex)
End Try
@@ -527,8 +528,8 @@ Retry:
Dim InstanceName As String = If(Json("name"), "")
Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Throw New OperationCanceledException
'解压
Dim InstallTemp As String = RequestTaskTempFolder()
Dim InstallLoaders As New List(Of LoaderBase)
@@ -556,7 +557,7 @@ Retry:
Dim LoaderName As String = "HMCL 整合包安装：" & InstanceName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中！", HintType.Red)
Throw New CancelledException
Throw New OperationCanceledException
End If
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
@@ -568,11 +569,11 @@ Retry:
End Function
'MMC
Private Function InstallPackMMC(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
Private Function InstallPackMMC(FileAddress As String, Archive As ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
'读取 Json 文件
Dim PackJson As JObject, PackInstance As String
Try
PackJson = GetJson(Archive.GetEntry(ArchiveBaseFolder & "mmc-pack.json").Open().ReadString(Encoding.UTF8))
PackJson = Archive.GetEntry(ArchiveBaseFolder & "mmc-pack.json").Open().ReadString(Encoding.UTF8).DeserializeJson()
PackInstance = Archive.GetEntry(ArchiveBaseFolder & "instance.cfg").Open().ReadString(Encoding.UTF8)
Catch ex As Exception
Throw New Exception("MMC 整合包安装信息存在问题", ex)
@@ -581,8 +582,8 @@ Retry:
Dim InstanceName As String = If(PackInstance.RegexSeek("(?<=\nname\=)[^\n]+"), "")
Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Throw New OperationCanceledException
'解压
Dim InstallTemp As String = RequestTaskTempFolder()
Dim SetupFile As String = $"{McFolderSelected}versions\{InstanceName}\PCL\Setup.ini"
@@ -609,7 +610,7 @@ Retry:
Dim PreLaunchCommand As String = ReadIni(MmcSetupFile, "PreLaunchCommand")
If PreLaunchCommand <> "" Then
PreLaunchCommand = PreLaunchCommand.Replace("\""", """").
Replace("$INST_JAVA", "{java}javaw.exe").
Replace("$INST_JAVA", "{java}java.exe").
Replace("$INST_MC_DIR\", "{minecraft}").Replace("$INST_MC_DIR", "{minecraft}").
Replace("$INST_DIR\", "{verpath}").Replace("$INST_DIR", "{verpath}").
Replace("$INST_ID", "{name}").Replace("$INST_NAME", "{name}")
@@ -622,10 +623,6 @@ Retry:
WriteIni(SetupFile, "VersionServerEnter", ServerAddress)
Logger.Info($"迁移 MultiMC 版本独立设置：自动进入服务器：{ServerAddress}")
End If
If ReadIni(MmcSetupFile, "IgnoreJavaCompatibility", False) Then
WriteIni(SetupFile, "VersionAdvanceJava", True)
Logger.Info("迁移 MultiMC 版本独立设置：忽略 Java 兼容性警告")
End If
Dim Logo As String = ReadIni(MmcSetupFile, "iconKey", "")
If Logo <> "" AndAlso FileUtils.Exists($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png") Then
WriteIni(SetupFile, "LogoCustom", True)
@@ -685,7 +682,7 @@ Retry:
Dim LoaderName As String = "MMC 整合包安装：" & InstanceName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中！", HintType.Red)
Throw New CancelledException
Throw New OperationCanceledException
End If
'启动
@@ -698,13 +695,13 @@ Retry:
End Function
'MCBBS
Private Function InstallPackMCBBS(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String,
Private Function InstallPackMCBBS(FileAddress As String, Archive As ZipArchive, ArchiveBaseFolder As String,
Optional InstanceName As String = Nothing) As LoaderCombo(Of String)
'读取 Json 文件
Dim Json As JObject
Try
Dim Entry = If(Archive.GetEntry(ArchiveBaseFolder & "mcbbs.packmeta"), Archive.GetEntry(ArchiveBaseFolder & "manifest.json"))
Json = GetJson(Entry.Open().ReadString(Encoding.UTF8))
Json = Entry.Open().ReadString(Encoding.UTF8).DeserializeJson()
Catch ex As Exception
Throw New Exception("MCBBS 整合包安装信息存在问题", ex)
End Try
@@ -713,8 +710,8 @@ Retry:
InstanceName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(McFolderSelected & "versions")
If Validate.Validate(InstanceName) <> "" Then InstanceName = ""
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Throw New CancelledException
If InstanceName = "" Then InstanceName = MyMsgBoxInput("输入版本名称", "", "", New Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(InstanceName) Then Throw New OperationCanceledException
End If
'解压
Dim InstallTemp As String = RequestTaskTempFolder()
@@ -742,7 +739,7 @@ Retry:
If Not Addons.ContainsKey("game") Then Throw New Exception("该 MCBBS 整合包未提供游戏版本信息，无法安装！")
If Addons.ContainsKey("quilt") Then
Hint("PCL 暂不支持安装需要 Quilt 的整合包！", HintType.Red)
Throw New CancelledException
Throw New OperationCanceledException
End If
Dim Request As New McInstallRequest With {
.NewInstanceName = InstanceName,
@@ -763,7 +760,7 @@ Retry:
Dim LoaderName As String = "MCBBS 整合包安装：" & InstanceName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中！", HintType.Red)
Throw New CancelledException
Throw New OperationCanceledException
End If
'启动
@@ -777,12 +774,12 @@ Retry:
End Function
'带启动器的压缩包
Private Function InstallPackLauncherPack(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
Private Function InstallPackLauncherPack(FileAddress As String, Archive As ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
'获取解压路径
MyMsgBox("接下来请选择一个空文件夹，它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
Dim TargetFolder As String = Dialogs.SelectFolder("选择安装目标（必须是一个空文件夹）", False).FirstOrDefault
If TargetFolder Is Nothing Then Throw New CancelledException
If Not DirectoryUtils.IsEmpty(TargetFolder) Then Hint("请选择一个空文件夹作为安装目标！", HintType.Red) : Throw New CancelledException
If TargetFolder Is Nothing Then Throw New OperationCanceledException
If Not DirectoryUtils.IsEmpty(TargetFolder) Then Hint("请选择一个空文件夹作为安装目标！", HintType.Red) : Throw New OperationCanceledException
'解压
Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
New LoaderTask(Of String, Integer)("解压压缩包",
@@ -792,7 +789,7 @@ Retry:
Thread.Sleep(400) '避免文件争用
'查找解压后的 exe 文件
Dim Launcher As String = Nothing
For Each ExeFile In DirectoryUtils.GetFiles(TargetFolder, True, "*.exe")
For Each ExeFile In DirectoryUtils.EnumerateFiles(TargetFolder, searchPattern:="*.exe")
Dim Info = FileVersionInfo.GetVersionInfo(ExeFile)
Logger.Info($"文件 {ExeFile} 的产品名标识为 {Info.ProductName}")
If Info.ProductName = "Plain Craft Launcher" Then
@@ -826,7 +823,7 @@ Retry:
TargetFolder & ".minecraft\" & ArchiveBaseFolder.Replace("/", "\").TrimStart("\"), '格式例如：包裹文件夹\.minecraft\（最短为空字符串）
InstanceName, False)
'调用 modpack 文件进行安装
Dim ModpackFile = DirectoryUtils.GetFiles(TargetFolder, "modpack.*").First
Dim ModpackFile = DirectoryUtils.EnumerateFiles(TargetFolder, True, "modpack.*").First
Logger.Info($"调用 modpack 文件继续安装：{ModpackFile}")
ModpackInstall(ModpackFile)
End Sub)
@@ -839,10 +836,10 @@ Retry:
End Function
'普通压缩包
Private Function InstallPackCompress(FileAddress As String, Archive As Compression.ZipArchive) As LoaderCombo(Of String)
Private Function InstallPackCompress(FileAddress As String, Archive As ZipArchive) As LoaderCombo(Of String)
'尝试定位 .minecraft 文件夹：寻找形如 “/versions/XXX/XXX.json” 的路径
Dim Match As RegularExpressions.Match = Nothing
Dim Regex As New RegularExpressions.Regex("^.*\/(?=versions\/(?<ver>[^\/]+)\/(\k<ver>)\.json$)", RegularExpressions.RegexOptions.IgnoreCase)
Dim Match As Match = Nothing
Dim Regex As New Regex("^.*\/(?=versions\/(?<ver>[^\/]+)\/(\k<ver>)\.json$)", RegexOptions.IgnoreCase)
For Each Entry In Archive.Entries
Dim EntryMatch = Regex.Match("/" & Entry.FullName)
If EntryMatch.Success Then
@@ -856,9 +853,9 @@ Retry:
'获取解压路径
MyMsgBox("接下来请选择一个空文件夹，它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
Dim TargetFolder As String = Dialogs.SelectFolder("选择安装目标（必须是一个空文件夹）", False).FirstOrDefault
If TargetFolder Is Nothing Then Throw New CancelledException
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号！", HintType.Red) : Throw New CancelledException
If Not DirectoryUtils.IsEmpty(TargetFolder) Then Hint("请选择一个空文件夹作为安装目标！", HintType.Red) : Throw New CancelledException
If TargetFolder Is Nothing Then Throw New OperationCanceledException
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号！", HintType.Red) : Throw New OperationCanceledException
If Not DirectoryUtils.IsEmpty(TargetFolder) Then Hint("请选择一个空文件夹作为安装目标！", HintType.Red) : Throw New OperationCanceledException
'解压
Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
New LoaderTask(Of String, Integer)("解压压缩包",
Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb
+5 -5
View File
@@ -1,4 +1,4 @@
Public Module ModWatcher
Public Module ModWatcher
'对全体的监视
Public McWatcherList As New List(Of Watcher)
@@ -91,7 +91,7 @@
RunInNewThread(
Sub()
Try
Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Crashed OrElse State = MinecraftState.Canceled OrElse Loader.State = LoadState.Interrupted
Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Crashed OrElse State = MinecraftState.Canceled OrElse Loader.State = LoadState.Canceled
TimerWindow()
TimerLog()
'设置窗口标题
@@ -177,7 +177,7 @@
Logger.Error(ex, "输出 Minecraft 日志失败")
End Try
End Sub
Public LatestLog As New Queue(Of String)
Public LatestLog As New ConcurrentQueue(Of String)
Private Sub GameLog(Text As String)
'预处理
If Text Is Nothing Then Return
@@ -185,7 +185,7 @@
'If Text.Contains("�����") Then Hint("检测到错误的日志编码：" & Text)
'加入预存储
LatestLog.Enqueue(Text)
If LatestLog.Count >= 501 Then LatestLog.Dequeue()
If LatestLog.Count >= 501 Then LatestLog.TryDequeue(Nothing)
Logger.Trace(Text)
'进度处理
If LogProgress < 1 Then
@@ -362,7 +362,7 @@
Analyzer.Prepare()
Analyzer.Analyze()
Analyzer.Output(False, New List(Of String) From
{Instance.PathVersion & Instance.Name & ".json", PathExeFolder & "PCL\Log1.txt", PathExeFolder & "PCL\LatestLaunch.bat"})
{Instance.PathVersion & Instance.Name & ".json", Paths.Base & "PCL\Log1.txt", Paths.Base & "PCL\LatestLaunch.bat"})
Catch ex As Exception
Logger.Error(ex, "崩溃分析失败")
End Try