This commit is contained in:
龙腾猫跃
2022-11-03 22:29:41 +08:00
parent e9b34ad998
commit ef32179598
42 changed files with 4212 additions and 187 deletions
@@ -458,7 +458,9 @@ Done:
If LogMc.Contains("Cannot read field ""ofTelemetry"" because ""net.optifine.Config.gameSettings"" is null") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("TRANSFORMER/net.optifine/net.optifine.reflect.Reflector.<clinit>(Reflector.java") Then AppendReason(CrashReason.OptiFine与Forge不兼容)
If LogMc.Contains("Open J9 is not supported") OrElse LogMc.Contains("OpenJ9 is incompatible") OrElse LogMc.Contains(".J9VMInternals.") Then AppendReason(CrashReason.使用OpenJ9)
If LogMc.Contains("Unsupported class file major version") Then AppendReason(CrashReason.Java版本过高)
If LogMc.Contains("because module java.base does not export") Then AppendReason(CrashReason.Java版本过高)
If LogMc.Contains("java.lang.ClassNotFoundException: jdk.nashorn.api.scripting.NashornScriptEngineFactory") Then AppendReason(CrashReason.Java版本过高)
If LogMc.Contains("java.lang.ClassNotFoundException: java.lang.invoke.LambdaMetafactory") Then AppendReason(CrashReason.Java版本过高)
If LogMc.Contains("The directories below appear to be extracted jar files. Fix this before you continue.") Then AppendReason(CrashReason.Mod文件被解压)
If LogMc.Contains("Extracted mod jars found, loading will NOT continue") Then AppendReason(CrashReason.Mod文件被解压)
@@ -468,7 +470,7 @@ Done:
If LogMc.Contains("1282: Invalid operation") Then AppendReason(CrashReason.光影或资源包导致OpenGL1282错误)
If LogMc.Contains("signer information does not match signer information of other classes in the same package") Then AppendReason(CrashReason.文件或内容校验失败, If(RegexSeek(LogMc, "(?<=class "")[^']+(?=""'s signer information)"), "").TrimEnd(vbCrLf))
If LogMc.Contains("An exception was thrown, the game will display an error screen and halt.") Then AppendReason(CrashReason.Forge报错, If(RegexSeek(LogMc, "(?<=the game will display an error screen and halt[\s\S]+?Exception: )[\s\S]+?(?=\n\tat)"), "").TrimEnd(vbCrLf))
If LogMc.Contains("A potential solution has been determined:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined:\n)(\t - [^\n]+\n)+"), ""), "(?<=\t)[^\n]+"), vbLf))
If LogMc.Contains("A potential solution has been determined:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf))
If LogMc.Contains("Maybe try a lower resolution resourcepack?") Then AppendReason(CrashReason.材质过大或显卡配置不足)
If LogMc.Contains("java.lang.NoSuchMethodError: net.minecraft.world.server.ChunkManager$ProxyTicketManager.shouldForceTicks(J)Z") AndAlso LogMc.Contains("OptiFine") Then AppendReason(CrashReason.OptiFine导致无法加载世界)
If LogMc.Contains("Could not reserve enough space") Then
@@ -773,7 +775,7 @@ Redo:
Case CrashReason.使用JDK
ResultString = "游戏似乎因为使用 JDK,或 Java 版本过高而崩溃了。\n请在启动设置的 Java 选择一项中改用 JRE 8(Java 8),然后再启动游戏。\n如果你没有安装 JRE 8,你可以从网络中下载、安装一个。"
Case CrashReason.Java版本过高
ResultString = "游戏似乎因为你所使用的 Java 版本过高而崩溃了。\n请在启动设置的 Java 选择一项中改用 JRE 8(Java 8),然后再启动游戏。\n如果你没有安装 JRE 8,你可以从网络中下载、安装一个。"
ResultString = "游戏似乎因为你所使用的 Java 版本过高而崩溃了。\n请在启动设置的 Java 选择一项中改用较低版本的 Java,然后再启动游戏。\n如果没有,可以从网络中下载、安装一个。"
Case CrashReason.使用32位Java导致JVM无法分配足够多的内存
If Environment.Is64BitOperatingSystem Then
ResultString = "你似乎正在使用 32 位 Java,这会导致 Minecraft 无法使用 1GB 以上的内存,进而造成崩溃。\n\n请在启动设置的 Java 选择一项中改用 64 位的 Java 再启动游戏,然后再启动游戏。\n如果你没有安装 64 位的 Java,你可以从网络中下载、安装一个。"
@@ -237,7 +237,9 @@
''' </summary>
Public DlClientListBmclapiLoader As New LoaderTask(Of Integer, DlClientListResult)("DlClientList Bmclapi", AddressOf DlClientListBmclapiMain)
Private Sub DlClientListBmclapiMain(Loader As LoaderTask(Of Integer, DlClientListResult))
Dim Json As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/mc/game/version_manifest.json", IsJson:=True)
Dim Json As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/mc/game/version_manifest.json",
BackupUrl:="https://download.mcbbs.net/mc/game/version_manifest.json",
IsJson:=True)
Try
Dim Versions As JArray = Json("versions")
If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Json.ToString & ")")
@@ -331,6 +333,10 @@
''' 发布时间,格式为“yyyy/mm/dd”。OptiFine 源无此数据。
''' </summary>
Public ReleaseTime As String
''' <summary>
''' 需要的最低 Forge 版本。空字符串为无限制,“28.1.56” 表示版本号,“1161” 表示版本号的最后一位。
''' </summary>
Public RequiredForgeVersion As String
End Class
''' <summary>
@@ -365,21 +371,23 @@
Dim Result As String = NetGetCodeByClient("https://optifine.net/downloads", Encoding.Default)
If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Result & ")")
'获取所有版本信息
Dim ReleaseTime As List(Of String) = RegexSearch(Result, "(?<=Date'>)[^<]+")
Dim Forge As List(Of String) = RegexSearch(Result, "(?<=colForge'>)[^<]*")
Dim ReleaseTime As List(Of String) = RegexSearch(Result, "(?<=colDate'>)[^<]+")
Dim Name As List(Of String) = RegexSearch(Result, "(?<=OptiFine_)[0-9A-Za-z_.]+(?=.jar"")")
If Not ReleaseTime.Count = Name.Count Then Throw New Exception("版本与发布时间数据无法对应")
If Not Forge.Count = Name.Count Then Throw New Exception("版本与 Forge 兼容数据无法对应")
If ReleaseTime.Count < 10 Then Throw New Exception("获取到的版本数量不足(" & Result & ")")
'转化为列表输出
Dim Versions As New List(Of DlOptiFineListEntry)
For i = 0 To ReleaseTime.Count - 1
Name(i) = Name(i).Replace("_", " ")
Dim Entry As New DlOptiFineListEntry With {
.NameDisplay = Name(i).ToString.Replace("HD U ", "").Replace(".0 ", " "),
.NameDisplay = Name(i).Replace("HD U ", "").Replace(".0 ", " "),
.ReleaseTime = Join({ReleaseTime(i).Split(".")(2), ReleaseTime(i).Split(".")(1), ReleaseTime(i).Split(".")(0)}, "/"),
.IsPreview = Name(i).ToString.ToLower.Contains("pre"),
.IsPreview = Name(i).ToLower.Contains("pre"),
.Inherit = Name(i).ToString.Split(" ")(0),
.NameFile = If(Name(i).ToString.ToLower.Contains("pre"), "preview_", "") &
"OptiFine_" & Name(i).ToString.Replace(" ", "_") & ".jar"}
.NameFile = If(Name(i).ToLower.Contains("pre"), "preview_", "") & "OptiFine_" & Name(i).Replace(" ", "_") & ".jar",
.RequiredForgeVersion = Forge(i).Replace("Forge ", "").Replace("#", "")}
Entry.NameVersion = Entry.Inherit & "-OptiFine_" & Name(i).ToString.Replace(" ", "_").Replace(Entry.Inherit & "_", "")
Versions.Add(Entry)
Next
@@ -391,7 +399,8 @@
''' </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 = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/optifine/versionList", IsJson:=True)
Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/optifine/versionList",
BackupUrl:="https://download.mcbbs.net/optifine/versionList", IsJson:=True)
Try
Dim Versions As New List(Of DlOptiFineListEntry)
For Each Token As JObject In Json
@@ -400,7 +409,8 @@
.ReleaseTime = "",
.IsPreview = Token("patch").ToString.ToLower.Contains("pre"),
.Inherit = Token("mcversion").ToString,
.NameFile = Token("filename").ToString
.NameFile = Token("filename").ToString,
.RequiredForgeVersion = If(Token("forge"), "").ToString.Replace("Forge ", "").Replace("#", "")
}
Entry.NameVersion = Entry.Inherit & "-OptiFine_" & (Token("type").ToString & " " & Token("patch").ToString).Replace(".0 ", " ").Replace(" ", "_").Replace(Entry.Inherit & "_", "")
Versions.Add(Entry)
@@ -473,7 +483,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 String = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft", Encoding.Default)
Dim Result As String = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft", Encoding.Default,
BackupUrl:="https://download.mcbbs.net/forge/minecraft")
If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Result & ")")
'获取所有版本信息
Dim Names As List(Of String) = RegexSearch(Result, "[0-9.]+(_pre[0-9]?)?")
@@ -665,7 +676,8 @@
''' Forge 版本列表,BMCLAPI。
''' </summary>
Public Sub DlForgeVersionBmclapiMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" & Loader.Input, IsJson:=True)
Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" & Loader.Input,
BackupUrl:="https://download.mcbbs.net/forge/minecraft/" & Loader.Input, IsJson:=True)
Dim Versions As New List(Of DlForgeVersionEntry)
Try
Dim Recommended As String = McDownloadForgeRecommendedGet(Loader.Input)
@@ -812,7 +824,7 @@
.IsPreview = RealEntry("stream").ToString.ToLower = "snapshot",
.FileName = "liteloader-installer-" & Pair.Key & If(Pair.Key = "1.8" OrElse Pair.Key = "1.9", ".0", "") & "-00-SNAPSHOT.jar",
.MD5 = RealEntry("md5"),
.ReleaseTime = GetLocalTime(GetDate(RealEntry("timestamp"))).ToString("yyyy/MM/dd HH:mm:ss"),
.ReleaseTime = GetLocalTime(GetDate(RealEntry("timestamp"))).ToString("yyyy/MM/dd HH:mm"),
.JsonToken = RealEntry
})
Next
@@ -827,7 +839,8 @@
''' </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 = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/maven/com/mumfrey/liteloader/versions.json", IsJson:=True)
Dim Result As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/maven/com/mumfrey/liteloader/versions.json",
BackupUrl:="https://download.mcbbs.net/maven/com/mumfrey/liteloader/versions.json", IsJson:=True)
Try
Dim Json As JObject = Result("versions")
Dim Versions As New List(Of DlLiteLoaderListEntry)
@@ -840,7 +853,7 @@
.IsPreview = RealEntry("stream").ToString.ToLower = "snapshot",
.FileName = "liteloader-installer-" & Pair.Key & If(Pair.Key = "1.8" OrElse Pair.Key = "1.9", ".0", "") & "-00-SNAPSHOT.jar",
.MD5 = RealEntry("md5"),
.ReleaseTime = GetLocalTime(GetDate(RealEntry("timestamp"))).ToString("yyyy/MM/dd HH:mm:ss"),
.ReleaseTime = GetLocalTime(GetDate(RealEntry("timestamp"))).ToString("yyyy/MM/dd HH:mm"),
.JsonToken = RealEntry
})
Next
@@ -913,7 +926,8 @@
''' </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 = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/fabric-meta/v2/versions", IsJson:=True)
Dim Result As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/fabric-meta/v2/versions",
BackupUrl:="https://download.mcbbs.net/fabric-meta/v2/versions", IsJson:=True)
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("获取到的列表缺乏必要项")
@@ -939,7 +953,7 @@
#Region "DlCfProject | CurseForge 工程"
Private DlCfProjectDb As Dictionary(Of String, String) = Nothing
Private DlCfProjectDb As Dictionary(Of String, DlCfDbEntry) = Nothing
Private DlCfProjectCache As New Dictionary(Of Integer, DlCfProject)
''' <summary>
@@ -988,7 +1002,6 @@
Public Id As Integer
Public Name As String
Public McWikiId As Integer = 0
Public Description As String
Public Website As String
Public DateUpdate As Date
@@ -1000,22 +1013,19 @@
Public IsModPack As Boolean
Public FileIndexes As New List(Of Integer)
Public Files As List(Of DlCfFile)
Private _MCBBS As String
Public Property MCBBS As String
Private _MCBBS As Integer?
Public Property MCBBS As Integer?
Get
ReleaseCfDatabase()
If _MCBBS Is Nothing Then
If Website IsNot Nothing Then
Dim Keyword As String = Website.TrimEnd("/").Split("/").Last
If DlCfProjectDb.ContainsKey(Keyword) Then
Dim Result As String() = DlCfProjectDb(Keyword).ToString.Split("|")
If Result.Length = 3 Then _MCBBS = Result.Last
End If
If DlCfProjectDb.ContainsKey(Keyword) Then _MCBBS = DlCfProjectDb(Keyword).MCBBS
End If
End If
Return _MCBBS
End Get
Set(value As String)
Set(value As Integer?)
_MCBBS = value
End Set
End Property
@@ -1028,20 +1038,42 @@
If Website IsNot Nothing Then
Dim Keyword As String = Website.TrimEnd("/").Split("/").Last
If DlCfProjectDb.ContainsKey(Keyword) Then
Dim Result As String = DlCfProjectDb(Keyword)
McWikiId = Result.Split("|")(0)
If Not Result.Split("|")(1) = "~" Then '使用原名
_ChineseName = Result.Split("|")(1)
Dim Result = DlCfProjectDb(Keyword)
If Not String.IsNullOrEmpty(Result.ChineseName) Then '使用原名
_ChineseName = Result.ChineseName
End If
End If
End If
End If
Return _ChineseName
End Get
Set(ByVal value As String)
Set(value As String)
_ChineseName = value
End Set
End Property
Private _WikiId As Integer = -1
''' <summary>
''' MCMOD 的页面 ID。若为 0 则代表没有对应页面。
''' </summary>
Public Property WikiId As Integer
Get
ReleaseCfDatabase()
If _WikiId = -1 Then
If Website IsNot Nothing Then
Dim Keyword As String = Website.TrimEnd("/").Split("/").Last
If DlCfProjectDb.ContainsKey(Keyword) Then
_WikiId = DlCfProjectDb(Keyword).WikiId
Else
_WikiId = 0
End If
End If
End If
Return _WikiId
End Get
Set(value As Integer)
_WikiId = value
End Set
End Property
''' <summary>
''' 从 CurseForge 工程 Json 项中初始化实例。若出错会抛出异常。
@@ -1180,7 +1212,8 @@
If(ShowVersionDesc, GameVersionDesc, "") &
Join(CategoryDesc, ",") & " (" &
GetTimeSpanString(DateUpdate - Date.Now) & "更新" &
If(DownloadCount > 0, "," & If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次下载)", DownloadCount & " 次下载)"), "")
If(DownloadCount > 0,
"," & If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次下载", DownloadCount & " 次下载"), "") & ")"
If Thumb Is Nothing Then
NewItem.Logo = "pack://application:,,,/images/Icons/NoIcon.png"
Else
@@ -1217,8 +1250,9 @@
''' CurseForge 工程列表获取事件。
''' </summary>
Public Sub DlCfProjectSub(Task As LoaderTask(Of DlCfProjectRequest, DlCfProjectResult))
Dim RawFilter As String = If(Task.Input.SearchFilter, "").Trim.ToLower
Dim RawFilter As String = If(Task.Input.SearchFilter, "").Trim
Task.Input.SearchFilter = RawFilter
RawFilter = RawFilter.ToLower
Log("[Download] CurseForge 工程列表搜索原始文本:" & RawFilter)
'中文请求关键字处理
Dim IsChineseSearch As Boolean = RegexCheck(RawFilter, "[\u4e00-\u9fbb]")
@@ -1227,12 +1261,12 @@
ReleaseCfDatabase()
'构造搜索请求
Dim SearchEntries As New List(Of SearchEntry(Of String))
For Each Entry In DlCfProjectDb
If Entry.Value.ToString.Contains("动态的树") Then Continue For '傻逼 Mod 的附属太多了
For Each Entry In DlCfProjectDb.Values
If If(Entry.ChineseName, "").Contains("动态的树") Then Continue For '傻逼 Mod 的附属太多了
SearchEntries.Add(New SearchEntry(Of String) With {
.Item = Entry.Value.ToString.Split("|")(1),
.Item = Entry.ChineseName,
.SearchSource = New List(Of KeyValuePair(Of String, Double)) From {
New KeyValuePair(Of String, Double)(Entry.Value.ToString.Replace(" (", "|").Split("|")(1), 1)
New KeyValuePair(Of String, Double)(Entry.ChineseName & Entry.CurseForgeId, 1)
}
})
Next
@@ -1258,12 +1292,12 @@
'驼峰英文请求关键字处理
Dim SpacedKeywords = RegexReplace(Task.Input.SearchFilter, "$& ", "([A-Z]+|[a-z]+?)(?=[A-Z]+[a-z]+[a-z ]*)")
Dim ConnectedKeywords = Task.Input.SearchFilter.Replace(" ", "")
Dim AllPossibleKeywords = SpacedKeywords & " " & If(IsChineseSearch, Task.Input.SearchFilter, ConnectedKeywords & " " & RawFilter)
Dim AllPossibleKeywords = (SpacedKeywords & " " & If(IsChineseSearch, Task.Input.SearchFilter, ConnectedKeywords & " " & RawFilter)).ToLower
'最终处理关键字:分割、去重
Dim RightKeywords As New List(Of String)
For Each Keyword In AllPossibleKeywords.Split(" ")
If Keyword.Trim = "" Then Continue For
If Keyword = "forge" OrElse Keyword = "fabric" OrElse Keyword = "for" Then 'https://github.com/Hex-Dragon/PCL2/issues/208
If Keyword = "forge" OrElse Keyword = "fabric" OrElse Keyword = "for" OrElse Keyword = "mod" Then 'https://github.com/Hex-Dragon/PCL2/issues/208
Log("[Download] 已跳过搜索关键词 " & Keyword, LogLevel.Developer)
Continue For
End If
@@ -1342,16 +1376,42 @@
''' </summary>
Private Sub ReleaseCfDatabase()
If DlCfProjectDb IsNot Nothing Then Exit Sub
DlCfProjectDb = New Dictionary(Of String, String)
For Each Entry In CType(GetJson(DecodeBytes(GetResources("ModData"))), JObject)
Dim Result As String = Entry.Value.ToString
If Not Result.Split("|")(1) = "~" Then '处理 *
Result = Result.Replace("*", " (" &
String.Join(" ", Entry.Key.Split("-").Select(Function(w) w.Substring(0, 1).ToUpper & w.Substring(1, w.Length - 1))) & ")")
DlCfProjectDb = New Dictionary(Of String, DlCfDbEntry)
For Each Line In DecodeBytes(GetResources("ModData")).Split(vbLf)
Dim Entry = New DlCfDbEntry
Dim SplitedLine = Line.Split("|")
Entry.CurseForgeId = SplitedLine(0)
Entry.WikiId = SplitedLine(1)
Entry.ChineseName = SplitedLine(2)
Entry.MCBBS = If(SplitedLine.Count = 4, SplitedLine(3), Nothing)
If Entry.ChineseName.Contains("*") Then '处理 *
Entry.ChineseName = Entry.ChineseName.Replace("*", " (" &
String.Join(" ", Entry.CurseForgeId.Split("-").Select(Function(w) w.Substring(0, 1).ToUpper & w.Substring(1, w.Length - 1))) & ")")
End If
DlCfProjectDb.Add(Entry.Key, Result)
DlCfProjectDb.Add(Entry.CurseForgeId, Entry)
Next
End Sub
Public Class DlCfDbEntry
''' <summary>
''' McMod 的 ID。
''' </summary>
Public WikiId As Integer
''' <summary>
''' 中文译名。若为 Nothing 或空字符串则使用英文名。
''' </summary>
Public ChineseName As String
''' <summary>
''' MCBBS 发布帖编号(例如 195107)。若为 Nothing 则没有发布帖。
''' </summary>
Public MCBBS As Integer?
''' <summary>
''' CurseForge ID(例如 advanced-solar-panels)。
''' </summary>
Public CurseForgeId As String
Public Overrides Function ToString() As String
Return CurseForgeId & "|" & WikiId & "|" & ChineseName & If(MCBBS Is Nothing, "", "|" & MCBBS)
End Function
End Class
#End Region
@@ -56,6 +56,7 @@ Public Module ModLaunch
New LoaderTask(Of Process, Integer)("等待游戏窗口出现", AddressOf McLaunchWait) With {.ProgressWeight = 1},
New LoaderTask(Of Integer, Integer)("结束处理", AddressOf McLaunchEnd) With {.ProgressWeight = 1}
}) With {.Show = False}
If McLoginLoader.State = LoadState.Finished Then McLoginLoader.State = LoadState.Waiting '要求重启登录主加载器,它会自行决定是否启动副加载器
'等待加载器执行并更新 UI
McLaunchLoaderReal = LaunchLoader
LaunchLoader.Start()
@@ -378,7 +379,7 @@ NextInner:
Return LoginData
End Function
Private Sub McLoginStart(Data As LoaderTask(Of McLoginData, McLoginResult))
McLaunchLog("登录线程已启动")
McLaunchLog("登录加载已开始")
'校验登录信息
Dim CheckResult As String = McLoginAble(Data.Input)
If Not CheckResult = "" Then Throw New ArgumentException(CheckResult)
@@ -390,7 +391,13 @@ NextInner:
Case McLoginType.Ms
Loader = McLoginMsLoader
Case McLoginType.Legacy
Loader = McLoginLegacyLoader
If PageLinkHiper.HiperState = LoadState.Finished Then
'使用 HiPer 内网验证
Loader = McLoginHiperLoader
Else
'默认的离线验证
Loader = McLoginLegacyLoader
End If
Case McLoginType.Nide
Loader = McLoginNideLoader
Case McLoginType.Auth
@@ -400,6 +407,7 @@ NextInner:
Loader.WaitForExit(Data.Input, McLoginLoader, Data.IsForceRestarting)
Data.Output = CType(Loader, Object).Output
RunInUi(Sub() FrmLaunchLeft.RefreshPage(True, False)) '刷新自动填充列表
McLaunchLog("登录加载已结束")
End Sub
#End Region
@@ -411,6 +419,7 @@ NextInner:
Public McLoginLegacyLoader As New LoaderTask(Of McLoginLegacy, McLoginResult)("Loader Login Legacy", AddressOf McLoginLegacyStart)
Public McLoginNideLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Nide", AddressOf McLoginServerStart) With {.ReloadTimeout = 60000}
Public McLoginAuthLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Auth", AddressOf McLoginServerStart) With {.ReloadTimeout = 60000}
Public McLoginHiperLoader As New LoaderTask(Of McLoginLegacy, McLoginResult)("Loader Login HiPer", AddressOf McLoginHiperStart) With {.ReloadTimeout = 60000}
'主加载函数,返回所有需要的登录信息
Private Sub McLoginMsStart(Data As LoaderTask(Of McLoginMs, McLoginResult))
@@ -545,43 +554,9 @@ LoginFinish:
Data.Progress = 0.1
With Data.Output
.Name = Input.UserName
.Uuid = McLoginLegacyUuid(Input.UserName)
.Uuid = McLoginLegacyUuidWithCustomSkin(Input.UserName, Input.SkinType, Input.SkinName)
.Type = "Legacy"
End With
'根据离线皮肤获取实际使用的 Uuid
Select Case Input.SkinType
Case 0
'默认,不需要处理
Case 1
'Steve
Do Until McSkinSex(Data.Output.Uuid) = "Steve"
If Data.Output.Uuid.EndsWith("FFFFF") Then Data.Output.Uuid = Mid(Data.Output.Uuid, 1, 32 - 5) & "00000"
Data.Output.Uuid = Mid(Data.Output.Uuid, 1, 32 - 5) & (Long.Parse(Right(Data.Output.Uuid, 5), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X")
Loop
Case 2
'Alex
Do Until McSkinSex(Data.Output.Uuid) = "Alex"
If Data.Output.Uuid.EndsWith("FFFFF") Then Data.Output.Uuid = Mid(Data.Output.Uuid, 1, 32 - 5) & "00000"
Data.Output.Uuid = Mid(Data.Output.Uuid, 1, 32 - 5) & (Long.Parse(Right(Data.Output.Uuid, 5), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X")
Loop
Case 3
'使用正版用户名
Try
If Not Input.SkinName = "" Then
Log("[Skin] 由于离线皮肤设置,使用正版 UUID:" & Input.SkinName)
Data.Output.Uuid = McLoginMojangUuid(Input.SkinName, False)
End If
Catch ex As Exception
Log(ex, "离线启动时使用的正版皮肤获取失败")
MyMsgBox("由于设置的离线启动时使用的正版皮肤获取失败,游戏将以无皮肤的方式启动。" & vbCrLf & "请检查你的网络是否通畅,或尝试使用 VPN!" & vbCrLf & vbCrLf & "详细的错误信息:" & ex.Message, "皮肤获取失败")
End Try
Case 4
'自定义
Do Until McSkinSex(Data.Output.Uuid) = If(Setup.Get("LaunchSkinSlim"), "Alex", "Steve")
If Data.Output.Uuid.EndsWith("FFFFF") Then Data.Output.Uuid = Mid(Data.Output.Uuid, 1, 32 - 5) & "00000"
Data.Output.Uuid = Mid(Data.Output.Uuid, 1, 32 - 5) & (Long.Parse(Right(Data.Output.Uuid, 5), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X")
Loop
End Select
'将结果扩展到所有项目中
'Data.Output.AccessToken = Setup.Get("CacheMojangAccess") '不能优先使用缓存的 AccessToken,这会导致离线用户名设置失效
'If Data.Output.AccessToken.Length < 300 Then
@@ -596,6 +571,46 @@ LoginFinish:
Names.Insert(0, Input.UserName)
Setup.Set("LoginLegacyName", Join(Names.ToArray, "¨"))
End Sub
Private Sub McLoginHiperStart(Data As LoaderTask(Of McLoginLegacy, McLoginResult))
Dim Input As McLoginLegacy = Data.Input
McLaunchLog("登录方式:联机离线(" & Input.UserName & ")")
Data.Progress = 0.05
'尝试登录
Try
McLaunchLog("登录开始(Login, HiPer)")
Dim LoginJson As JObject = GetJson(NetRequestRetry(
Url:="http://hiperauth.tech/api/yggdrasil-hiper/authserver/authenticate",
Method:="POST",
Data:="{""agent"": {""name"": ""Minecraft"",""version"": 1},""username"":""" & Data.Input.UserName & """,""password"":""" &
McLoginLegacyUuidWithCustomSkin(Input.UserName, Input.SkinType, Input.SkinName) & """,""requestUser"":true}",
ContentType:="application/json; charset=utf-8"))
'将登录结果输出
Data.Output.AccessToken = LoginJson("accessToken").ToString
Data.Output.ClientToken = LoginJson("clientToken").ToString
Data.Output.Name = LoginJson("selectedProfile")("name").ToString
Data.Output.Uuid = LoginJson("selectedProfile")("id").ToString
Data.Output.Type = "Auth"
Data.Output.Email = Data.Input.UserName
McLaunchLog("登录成功(Login, HiPer)")
'保存启动记录
Dim Names As New List(Of String)
If Not Setup.Get("LoginLegacyName") = "" Then Names.AddRange(Setup.Get("LoginLegacyName").ToString.Split("¨"))
Names.Remove(Input.UserName)
Names.Insert(0, Input.UserName)
Setup.Set("LoginLegacyName", Join(Names.ToArray, "¨"))
Catch ex As Exception
Dim AllMessage As String = GetString(ex)
Log(ex, "登录失败原始错误信息", LogLevel.Normal)
Dim ThrowEx As Exception = ex
If AllMessage.Contains("403") Then
ThrowEx = New Exception("登录尝试过于频繁,导致被系统暂时屏蔽。请不要操作,等待 10 分钟后再试。", ex)
ElseIf AllMessage.Contains("超时") OrElse AllMessage.Contains("imeout") OrElse AllMessage.Contains("网络请求失败") Then
ThrowEx = New Exception("$登录失败:连接登录服务器超时。" & vbCrLf & "请检查 HiPer 联机模块的连接状况是否良好,或选择其他登录方式!")
End If
McLaunchLog("登录失败:" & GetString(ThrowEx))
Throw ThrowEx
End Try
End Sub
'Server 登录:三种验证方式的请求
Private Sub McLoginRequestValidate(ByRef Data As LoaderTask(Of McLoginServer, McLoginResult))
@@ -752,10 +767,8 @@ LoginFinish:
If(Data.Input.UserName.Contains("@"), "", " - 登录账号应为邮箱或统一通行证账号,而非游戏角色 ID。" & vbCrLf) &
" - 只注册了账号,但没有加入对应服务器。")
End Select
ElseIf AllMessage.Contains("超时") OrElse AllMessage.Contains("imeout") Then
ElseIf AllMessage.Contains("超时") OrElse AllMessage.Contains("imeout") OrElse AllMessage.Contains("网络请求失败") Then
Throw New Exception("$登录失败:连接登录服务器超时。" & vbCrLf & "请检查你的网络状况是否良好,或尝试使用 VPN!")
ElseIf AllMessage.Contains("网络请求失败") Then
Throw New Exception("$登录失败:连接登录服务器失败。" & vbCrLf & "请检查你的网络状况是否良好,或尝试使用 VPN!")
ElseIf ex.Message.StartsWith("$") Then
Throw
Else
@@ -845,7 +858,7 @@ SystemBrowser:
Try
Result = NetRequestMuity("https://login.live.com/oauth20_token.srf", "POST", Request, "application/x-www-form-urlencoded", 1)
Catch ex As Exception
If ex.Message.Contains("must sign in again") Then
If ex.Message.Contains("must sign in again") OrElse ex.Message.Contains("invalid_grant") Then 'Fix Hex-Dragon/PCL2#269
Return {"Relogin", ""}
Else
Throw
@@ -895,7 +908,11 @@ SystemBrowser:
Result = NetRequestMuity("https://xsts.auth.xboxlive.com/xsts/authorize", "POST", Request, "application/json", 3)
Catch ex As Net.WebException
If ex.Message.Contains("2148916233") Then
Throw New Exception("$该微软账号尚未购买 Minecraft Java 版或注册 XBox 账户!")
If MyMsgBox("该微软账号尚未购买 Minecraft Java 版,或尚未注册 XBox 账户。" & vbCrLf &
"如果你确定该账号完成了上述步骤,请先在游戏官网登录一次,然后再在启动器登录。", "登录提示", "打开游戏官网", "取消") = 1 Then
OpenWebsite("https://www.minecraft.net/")
End If
Throw New Exception("$$")
ElseIf ex.Message.Contains("2148916238") Then
If MyMsgBox("该账号年龄不足,你需要先修改出生日期,然后才能登录。" & vbCrLf &
"该账号目前填写的年龄是否在 13 岁以上?", "登录提示", "13 岁以上", "12 岁以下", "我不知道") = 1 Then
@@ -968,7 +985,46 @@ SystemBrowser:
Return {UUID, UserName, Result}
End Function
'根据用户名返回对应 Uuid,需要多线程
'返回符合离线皮肤设置的 UUID
Private Function McLoginLegacyUuidWithCustomSkin(UserName As String, SkinType As Integer, SkinName As String) As String
Dim Uuid As String = McLoginLegacyUuid(UserName)
'根据离线皮肤获取实际使用的 Uuid
Select Case SkinType
Case 0
'默认,不需要处理
Case 1
'Steve
Do Until McSkinSex(Uuid) = "Steve"
If Uuid.EndsWith("FFFFF") Then Uuid = Mid(Uuid, 1, 32 - 5) & "00000"
Uuid = Mid(Uuid, 1, 32 - 5) & (Long.Parse(Right(Uuid, 5), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X")
Loop
Case 2
'Alex
Do Until McSkinSex(Uuid) = "Alex"
If Uuid.EndsWith("FFFFF") Then Uuid = Mid(Uuid, 1, 32 - 5) & "00000"
Uuid = Mid(Uuid, 1, 32 - 5) & (Long.Parse(Right(Uuid, 5), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X")
Loop
Case 3
'使用正版用户名
Try
If Not SkinName = "" Then
Log("[Skin] 由于离线皮肤设置,使用正版 UUID:" & SkinName)
Uuid = McLoginMojangUuid(SkinName, False)
End If
Catch ex As Exception
Log(ex, "离线启动时使用的正版皮肤获取失败")
MyMsgBox("由于设置的离线启动时使用的正版皮肤获取失败,游戏将以无皮肤的方式启动。" & vbCrLf & "请检查你的网络是否通畅,或尝试使用 VPN!" & vbCrLf & vbCrLf & "详细的错误信息:" & ex.Message, "皮肤获取失败")
End Try
Case 4
'自定义
Do Until McSkinSex(Uuid) = If(Setup.Get("LaunchSkinSlim"), "Alex", "Steve")
If Uuid.EndsWith("FFFFF") Then Uuid = Mid(Uuid, 1, 32 - 5) & "00000"
Uuid = Mid(Uuid, 1, 32 - 5) & (Long.Parse(Right(Uuid, 5), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X")
Loop
End Select
Return Uuid
End Function
'根据用户名返回对应 UUID,需要多线程
Public Function McLoginMojangUuid(Name As String, ThrowOnNotFound As Boolean)
If Name.Trim.Length = 0 Then Return StrFill("", "0", 32)
'从缓存获取
@@ -1017,8 +1073,8 @@ SystemBrowser:
ElseIf McVersionCurrent.ReleaseTime.Year >= 2017 Then 'Minecraft 1.12 与 1.11 的分界线正好是 2017 年,太棒了
'1.12+:至少 Java 8
MinVer = New Version(1, 8, 0, 0)
ElseIf McVersionCurrent.ReleaseTime.Year >= 2001 Then '避免某些版本的 1960 癌
'1.11-:最高 Java 12
ElseIf McVersionCurrent.ReleaseTime <= New Date(2013, 5, 1) AndAlso McVersionCurrent.ReleaseTime.Year >= 2001 Then '避免某些版本的 1960 癌
'1.5.2-:最高 Java 12
MaxVer = New Version(1, 12, 999, 999)
End If
@@ -1027,15 +1083,29 @@ SystemBrowser:
If McVersionCurrent.Version.McName = "1.7.2" Then
'1.7.2:必须 Java 7
MinVer = New Version(1, 7, 0, 0) : MaxVer = New Version(1, 7, 999, 999)
ElseIf McVersionCurrent.Version.McCodeMain <= 12 AndAlso McVersionCurrent.Version.McCodeMain <> -1 AndAlso VersionSortBoolean("14.23.5.2855", McVersionCurrent.Version.ForgeVersion) Then
ElseIf McVersionCurrent.Version.McCodeMain <= 12 AndAlso McVersionCurrent.Version.McCodeMain > 0 AndAlso VersionSortBoolean("14.23.5.2855", McVersionCurrent.Version.ForgeVersion) Then
'1.12,Forge 14.23.5.2855 及更低:Java 8
MaxVer = New Version(1, 8, 999, 999)
ElseIf McVersionCurrent.Version.McCodeMain <= 14 AndAlso McVersionCurrent.Version.McCodeMain <> -1 AndAlso VersionSortBoolean("28.2.23", McVersionCurrent.Version.ForgeVersion) Then
ElseIf McVersionCurrent.Version.McCodeMain <= 14 AndAlso McVersionCurrent.Version.McCodeMain > 0 AndAlso VersionSortBoolean("28.2.23", McVersionCurrent.Version.ForgeVersion) Then
'1.13 - 1.14,Forge 28.2.23 及更低:Java 8 - 10
MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 10, 999, 999)
ElseIf McVersionCurrent.Version.McCodeMain <= 16 AndAlso McVersionCurrent.Version.McCodeMain <> -1 Then
'1.15 - 1.16:Java 8 - 12, 12 - 15未测试
ElseIf McVersionCurrent.Version.McCodeMain <= 16 AndAlso McVersionCurrent.Version.McCodeMain > 0 Then
'1.15 - 1.16:Java 8 - 15
MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 15, 999, 999)
ElseIf McVersionCurrent.Version.McCodeMain >= 18 AndAlso McVersionCurrent.Version.McCodeMain < 99 AndAlso McVersionCurrent.Version.HasOptiFine Then '#305
'1.18+:若安装了 OptiFine,最高 Java 18
MaxVer = New Version(1, 18, 999, 999)
End If
End If
'Fabric 检测
If McVersionCurrent.Version.HasFabric Then
If McVersionCurrent.Version.McCodeMain >= 15 AndAlso McVersionCurrent.Version.McCodeMain <= 16 AndAlso McVersionCurrent.Version.McCodeMain <> -1 Then
'1.15 - 1.16:Java 8 - 15
MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 15, 999, 999)
ElseIf McVersionCurrent.Version.McCodeMain >= 18 AndAlso McVersionCurrent.Version.McCodeMain < 99 Then
'1.18+:Java 17 - 18
MinVer = New Version(1, 17, 0, 0) : MaxVer = New Version(1, 18, 999, 999)
End If
End If
@@ -1084,9 +1154,17 @@ SystemBrowser:
''' </summary>
Public Function ExtractJavaWrapper() As String
Dim WrapperPath As String = PathAppdata & "JavaWrapper.jar"
If Encoding.UTF8.GetByteCount(WrapperPath) <> WrapperPath.Length Then
Log("[Java] AppData 路径中包含非 ASCII 字符,换用 Temp 目录")
WrapperPath = PathTemp & "JavaWrapper.jar"
If Encoding.UTF8.GetByteCount(PathTemp) <> PathTemp.Length Then
Log("[Java] Temp 路径中包含非 ASCII 字符,换用 C 盘根目录")
WrapperPath = "C:\PCL\JavaWrapper.jar"
End If
End If
If Not File.Exists(WrapperPath) OrElse New FileInfo(WrapperPath).Length > 20 * 1024 Then
WriteFile(WrapperPath, GetResources("JavaWrapper"))
McLaunchLog("已自动释放 Java Wrapper")
Log("[Java] 已自动释放 Java Wrapper:" & WrapperPath)
End If
Return WrapperPath
End Function
@@ -1173,14 +1251,16 @@ SystemBrowser:
'统一通行证
If McLoginLoader.Output.Type = "Nide" Then
DataList.Insert(0, "-Dnide8auth.client=true -javaagent:nide8auth.jar=" & Setup.Get("VersionServerNide", Version:=McVersionCurrent))
DataList.Insert(0, "-Dnide8auth.client=true -javaagent:""" & PathAppdata & "nide8auth.jar""=" & Setup.Get("VersionServerNide", Version:=McVersionCurrent))
End If
'Authlib-Injector
If McLoginLoader.Output.Type = "Auth" Then
Dim Server As String = Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent)
Dim Server As String = If(McLoginLoader.Input.Type = McLoginType.Legacy,
"http://hiperauth.tech/api/yggdrasil-hiper/", 'HiPer 登录
Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent))
Try
Dim Response As String = NetGetCodeByRequestRetry(Server, Encoding.UTF8)
DataList.Insert(0, "-javaagent:authlib-injector.jar=" & Server &
DataList.Insert(0, "-javaagent:""" & PathAppdata & "authlib-injector.jar""=" & Server &
" -Dauthlibinjector.side=client" &
" -Dauthlibinjector.yggdrasil.prefetched=" & Convert.ToBase64String(Encoding.UTF8.GetBytes(Response)))
Catch ex As Exception
@@ -1237,14 +1317,16 @@ NextVersion:
'统一通行证
If McLoginLoader.Output.Type = "Nide" Then
DataList.Insert(0, "-javaagent:nide8auth.jar=" & Setup.Get("VersionServerNide", Version:=McVersionCurrent))
DataList.Insert(0, "-javaagent:""" & PathAppdata & "nide8auth.jar""=" & Setup.Get("VersionServerNide", Version:=McVersionCurrent))
End If
'Authlib-Injector
If McLoginLoader.Output.Type = "Auth" Then
Dim Server As String = Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent)
Dim Server As String = If(McLoginLoader.Input.Type = McLoginType.Legacy,
"http://hiperauth.tech/api/yggdrasil-hiper/", 'HiPer 登录
Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent))
Try
Dim Response As String = NetGetCodeByRequestRetry(Server, Encoding.UTF8)
DataList.Insert(0, "-javaagent:authlib-injector.jar=" & Server &
DataList.Insert(0, "-javaagent:""" & PathAppdata & "authlib-injector.jar""=" & Server &
" -Dauthlibinjector.side=client" &
" -Dauthlibinjector.yggdrasil.prefetched=" & Convert.ToBase64String(Encoding.UTF8.GetBytes(Response)))
Catch ex As Exception
@@ -1420,7 +1502,9 @@ NextVersion:
GameArguments.Add("${assets_index_name}", McAssetsGetIndexName(Version))
'支持库参数
Dim LibList As List(Of McLibToken) = McLibListGet(Version, Not (Version.Version.HasForge AndAlso Version.Version.McCodeMain >= 17))
'Dim LibList As List(Of McLibToken) = McLibListGet(Version,
' Not (Version.Version.HasForge AndAlso Version.Version.McCodeMain >= 17)) '包含版本 Jar 的条件是不为 1.17+ 的 Forge
Dim LibList As List(Of McLibToken) = McLibListGet(Version, True) '如果在 1.19.x Forge 不包含版本 Jar 会导致 #188
Loader.Output = LibList
Dim CpStrings As New List(Of String)
Dim OptiFineCp As String = Nothing
@@ -1539,7 +1623,7 @@ NextVersion:
'更新文件
Dim Profiles As JObject = GetJson(ReadFile(PathMcFolder & "launcher_profiles.json"))
Profiles.Merge(ReplaceJson)
WriteFile(PathMcFolder & "launcher_profiles.json", Profiles.ToString, Encoding:=Encoding.Default)
WriteFile(PathMcFolder & "launcher_profiles.json", Profiles.ToString, Encoding:=Encoding.GetEncoding("GB18030"))
McLaunchLog("已更新 launcher_profiles.json")
Catch ex As Exception
Log(ex, "更新 launcher_profiles.json 失败,将在删除文件后重试")
@@ -1570,7 +1654,7 @@ NextVersion:
'更新文件
Dim Profiles As JObject = GetJson(ReadFile(PathMcFolder & "launcher_profiles.json"))
Profiles.Merge(ReplaceJson)
WriteFile(PathMcFolder & "launcher_profiles.json", Profiles.ToString, Encoding:=Encoding.Default)
WriteFile(PathMcFolder & "launcher_profiles.json", Profiles.ToString, Encoding:=Encoding.GetEncoding("GB18030"))
McLaunchLog("已在删除后更新 launcher_profiles.json")
Catch exx As Exception
Log(exx, "更新 launcher_profiles.json 失败", LogLevel.Feedback)
@@ -1770,7 +1854,7 @@ IgnoreCustomSkin:
"""" & McLaunchJavaSelected.PathJava & """ " & McLaunchArgument & vbCrLf &
"echo 游戏已退出。" & vbCrLf &
"pause"
WriteFile(Path & "PCL\LatestLaunch.bat", CmdString, Encoding:=Encoding.Default)
WriteFile(Path & "PCL\LatestLaunch.bat", CmdString, Encoding:=Encoding.GetEncoding("GB18030"))
Catch ex As Exception
Log(ex, "输出启动脚本失败")
End Try
@@ -484,10 +484,22 @@ RetryGet:
End If
Next
Log("[Java] 发现用户指定的不兼容 Java:" & UserJava.ToString)
If MyMsgBox("你在启动设置中指定了使用下列 Java:" & vbCrLf &
" - " & UserJava.ToString & vbCrLf &
'弹窗要求选择
Dim Requirement As String = ""
If (MinVersion Is Nothing OrElse MinVersion.Minor = 0) AndAlso (MaxVersion IsNot Nothing AndAlso MaxVersion.Minor < 99) Then
Requirement = "最高兼容到 Java " & MaxVersion.Minor & If(MaxVersion.MinorRevision < 99, "." & MaxVersion.MinorRevision & "." & MaxVersion.Revision, "")
ElseIf (MinVersion IsNot Nothing AndAlso MinVersion.Minor > 0) AndAlso (MaxVersion Is Nothing OrElse MaxVersion.Minor >= 99) Then
Requirement = "至少需要 Java " & MinVersion.Minor & If(MinVersion.MinorRevision > 0 OrElse MinVersion.Revision > 0, "." & MinVersion.MinorRevision & "." & MinVersion.Revision, "")
ElseIf (MinVersion IsNot Nothing AndAlso MinVersion.Minor > 0) AndAlso (MaxVersion IsNot Nothing AndAlso MaxVersion.Minor < 99) Then
Dim Left As String = MinVersion.Minor & If(MinVersion.MinorRevision > 0 OrElse MinVersion.Revision > 0, "." & MinVersion.MinorRevision & "." & MinVersion.Revision, "")
Dim Right As String = MaxVersion.Minor & If(MaxVersion.MinorRevision < 99, "." & MaxVersion.MinorRevision & "." & MaxVersion.Revision, "")
Requirement = "需要 Java " & If(Left = Right, Left, Left & " ~ " & Right)
End If
If MyMsgBox("你在启动设置中指定了使用 Java " & UserJava.VersionCode & ",但当前版本" & Requirement & "。" & vbCrLf &
"如果强制使用该 Java,可能会导致游戏崩溃。" & vbCrLf &
vbCrLf &
"该 Java 可能不兼容当前游戏版本,游戏存在崩溃风险。是否要强制使用该 Java?", "Java 兼容性警告", "取消,让 PCL2 自动选择", "继续") = 2 Then
" - 指定的 Java:" & UserJava.ToString,
"Java 兼容性警告", "让 PCL2 自动选择", "强制使用该 Java") = 2 Then
'强制使用指定的 Java
Log("[Java] 已强制使用用户指定的不兼容 Java")
AllowedJavaList = New List(Of JavaEntry) From {UserJava}
@@ -581,8 +593,8 @@ UserPass:
If Not Left.IsJre AndAlso Right.IsJre Then Return False
'4. Java 大版本
If Left.VersionCode <> Right.VersionCode Then
' Java 7 8 9 10 11 12 13 14 15 16 17 18 19
Dim Weight = {0, 1, 2, 3, 4, 5, 6, 14, 29, 10, 11, 12, 13, 9, 8, 7, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28}
' Java 7 8 9 10 11 12 13 14 15 16 17 18 19 20...
Dim Weight = {0, 1, 2, 3, 4, 5, 6, 14, 29, 10, 11, 12, 13, 9, 8, 7, 15, 30, 29, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28}
Return Weight.ElementAtOrDefault(Left.VersionCode) >= Weight.ElementAtOrDefault(Right.VersionCode)
End If
'5. 最次级版本号更接近 51
@@ -773,7 +785,7 @@ UserPass:
""selectedProfile"": ""PCL2"",
""clientToken"": ""23323323323323323323323323323333""
}"
WriteFile(Folder & "launcher_profiles.json", ResultJson, Encoding:=Encoding.Default)
WriteFile(Folder & "launcher_profiles.json", ResultJson, Encoding:=Encoding.GetEncoding("GB18030"))
Log("[Minecraft] 已创建 launcher_profiles.json:" & Folder)
Catch ex As Exception
Log(ex, "创建 launcher_profiles.json 失败(" & Folder & ")", LogLevel.Feedback)
@@ -2486,22 +2498,23 @@ NextVersion:
'统一通行证文件
If Setup.Get("VersionServerLogin", Version:=Version) = 3 Then
Dim TargetFile = Version.PathIndie & "nide8auth.jar"
Dim TargetFile = PathAppdata & "nide8auth.jar"
Dim Checker As New FileChecker(MinSize:=173000)
If (IsSetupSkip AndAlso File.Exists(TargetFile)) OrElse Checker.Check(TargetFile) IsNot Nothing Then
Result.Add(New NetFile({"https://login.mc-user.com:233/index/jar"}, TargetFile, Checker))
End If
End If
'Authlib-Injector 文件
If Setup.Get("VersionServerLogin", Version:=Version) = 4 Then
Dim TargetFile = Version.PathIndie & "authlib-injector.jar"
If Setup.Get("VersionServerLogin", Version:=Version) = 4 OrElse
(PageLinkHiper.HiperState = LoadState.Finished AndAlso Setup.Get("LoginType") = McLoginType.Legacy) Then 'HiPer 登录转接
Dim TargetFile = PathAppdata & "authlib-injector.jar"
Dim DownloadInfo As JObject = Nothing
'获取下载信息
Try
Log("[Minecraft] 开始获取 Authlib-Injector 下载信息")
DownloadInfo = GetJson(NetGetCodeByDownload({"https://download.mcbbs.net/mirrors/authlib-injector/artifact/latest.json", "https://bmclapi2.bangbang93.com/mirrors/authlib-injector/artifact/latest.json"}, IsJson:=True))
Catch ex As Exception
Log("获取 Authlib-Injector 下载信息失败", LogLevel.Hint)
Log(ex, "获取 Authlib-Injector 下载信息失败")
End Try
'校验文件
If DownloadInfo IsNot Nothing Then
@@ -3804,7 +3817,11 @@ NextEntry:
Else
Select Case McLoginLoader.Input.Type
Case McLoginType.Legacy
Raw = Raw.Replace("{login}", "离线")
If PageLinkHiper.HiperState = LoadState.Finished Then
Raw = Raw.Replace("{login}", "联机离线")
Else
Raw = Raw.Replace("{login}", "离线")
End If
Case McLoginType.Mojang
Raw = Raw.Replace("{login}", "Mojang 正版")
Case McLoginType.Ms
@@ -126,7 +126,7 @@
End If
'解压文件
Dim RetryCount As Integer = 1
Dim Encode = Encoding.Default
Dim Encode = Encoding.GetEncoding("GB18030")
Try
Retry:
'完全不知道为啥会出现文件正在被另一进程使用的问题,总之多试试
@@ -94,7 +94,6 @@
Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Crashed OrElse Loader.State = LoadState.Aborted
TimerWindow()
TimerLog()
If State = MinecraftState.Loading Then ProgressUpdate()
'设置窗口标题
For i = 1 To 3
If IsWindowFinished AndAlso WindowTitle <> "" AndAlso State = MinecraftState.Running AndAlso Not GameProcess.HasExited Then
@@ -151,6 +150,7 @@
For Each Str As String In Copyed
GameLog(Str)
Next
If State = MinecraftState.Loading Then ProgressUpdate()
'游戏退出检查
If GameProcess.HasExited Then
WatcherLog("Minecraft 已退出,返回值:" & GameProcess.ExitCode)
@@ -167,7 +167,7 @@
'返回值不为 0 且未结束
WatcherLog("Minecraft 返回值异常,可能已崩溃")
Crashed()
Else
ElseIf State <> MinecraftState.Crashed Then
'正常关闭
State = MinecraftState.Ended
End If
@@ -268,8 +268,18 @@
WatcherLog("Minecraft 窗口已加载:" & WindowHandle.ToInt64)
IsWindowFinished = True
'最大化
Thread.Sleep(3000) '1.7.10 LiteLoader 不延迟会显示错误
If Setup.Get("LaunchArgumentWindowType") = 4 Then ShowWindow(WindowHandle, 3)
If Setup.Get("LaunchArgumentWindowType") = 4 Then
RunInNewThread(Sub()
Try
'如果最大化导致屏幕渲染大小不对,那是 MC 的 Bug,不是我的 Bug
'……虽然我很想这样说,但总有人反馈,算了
Thread.Sleep(1000)
ShowWindow(WindowHandle, 3)
Catch ex As Exception
Log(ex, "最大化 Minecraft 窗口时出现错误")
End Try
End Sub, "MinecraftWindowMaximize")
End If
ElseIf Not IsWindowAppeared Then
'已找到 FML 窗口
WatcherLog("FML 窗口已加载:" & MinecraftWindows.Keys(0).ToInt64)