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

2.12.0

Browse Source
This commit is contained in:
龙腾猫跃
2025-12-27 02:48:47 +08:00
parent d6ba445e54
commit 085af160a1
78 changed files with 8426 additions and 4863 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb
+164 -146
View File
@@ -177,13 +177,15 @@
''' </summary>
Public ReadOnly Tags As List(Of String)
''' <summary>
''' Logo 图片的下载地址。若为 Nothing 则没有。
''' Logo 图片的下载地址。
''' 若为 Nothing 则没有，保证不为空字符串。
''' </summary>
Public LogoUrl As String = Nothing
''' <summary>
''' 游戏大版本列表。例如：18, 16, 15……
''' 支持的 Drop 编号，从高到低排序，不为 Nothing。
''' 例如：261（26.1.x）、180（1.18.x）。
''' </summary>
Public ReadOnly GameVersions As List(Of Integer)
Public ReadOnly Drops As List(Of Integer)
'数据库信息
@@ -249,10 +251,10 @@
End If
Tags = CType(Data("Tags"), JArray).Select(Function(t) t.ToString).ToList
If Data.ContainsKey("LogoUrl") Then LogoUrl = Data("LogoUrl")
If Data.ContainsKey("GameVersions") Then
GameVersions = CType(Data("GameVersions"), JArray).Select(Function(t) t.ToObject(Of Integer)).ToList
If Data.ContainsKey("Drops") Then
Drops = CType(Data("Drops"), JArray).Select(Function(t) t.ToObject(Of Integer)).ToList
Else
GameVersions = New List(Of Integer)
Drops = New List(Of Integer)
End If
#End Region
Else
@@ -274,6 +276,7 @@
LogoUrl = Data("logo")("thumbnailUrl")
End If
End If
If LogoUrl = "" Then LogoUrl = Nothing
'Type
If Website.Contains("/mc-mods/") OrElse Website.Contains("/mod/") Then
Type = CompType.Mod
@@ -288,7 +291,7 @@
Else
Type = CompType.DataPack
End If
'FileIndexes / GameVersions / ModLoaders
'FileIndexes / VanillaMajorVersions / ModLoaders
ModLoaders = New List(Of CompModLoaderType)
Dim Files As New List(Of KeyValuePair(Of Integer, List(Of String))) 'FileId, GameVersions
For Each File In If(Data("latestFiles"), New JArray)
@@ -296,17 +299,16 @@
If Not NewFile.Available Then Continue For
ModLoaders.AddRange(NewFile.ModLoaders)
Dim GameVersions = File("gameVersions").ToObject(Of List(Of String))
If Not GameVersions.Any(Function(v) v.StartsWithF("1.")) Then Continue For
If Not GameVersions.Any(Function(v) McVersion.IsFormatFit(v)) Then Continue For
Files.Add(New KeyValuePair(Of Integer, List(Of String))(File("id"), GameVersions))
Next
For Each File In If(Data("latestFilesIndexes"), New JArray) '这俩玩意儿包含的文件不一样，见 #3599
If Not File("gameVersion").ToString.StartsWithF("1.") Then Continue For
If Not McVersion.IsFormatFit(File("gameVersion")) Then Continue For
Files.Add(New KeyValuePair(Of Integer, List(Of String))(File("fileId"), {File("gameVersion").ToString}.ToList))
Next
CurseForgeFileIds = Files.Select(Function(f) f.Key).Distinct.ToList
GameVersions = Files.SelectMany(Function(f) f.Value).Where(Function(v) v.StartsWithF("1.")).
Select(Function(v) CInt(Val(v.Split(".")(1).BeforeFirst("-")))).Where(Function(v) v > 0).
Distinct.OrderByDescending(Function(v) v).ToList
Drops = Files.SelectMany(Function(f) f.Value).
Select(Function(v) McVersion.VersionToDrop(v)).Where(Function(v) v > 0).Distinct.OrderByDescending(Function(v) v).ToList
ModLoaders = ModLoaders.Distinct.OrderBy(Of Integer)(Function(t) t).ToList
'Tags
Tags = New List(Of String)
@@ -333,6 +335,8 @@
Case 424 : Tags.Add("装饰")
Case 411 : Tags.Add("生物")
Case 434 : Tags.Add("装备")
Case 6814 : Tags.Add("性能优化")
Case 9026 : Tags.Add("创造模式")
Case 423 : Tags.Add("信息显示")
Case 435 : Tags.Add("服务器")
Case 5191 : Tags.Add("改良")
@@ -399,10 +403,8 @@
Website = $"https://modrinth.com/{Data("project_type")}/{Slug}"
'GameVersions
'搜索结果的键为 versions，获取特定工程的键为 game_versions
GameVersions = If(CType(If(Data("game_versions"), Data("versions")), JArray), New JArray).
Select(Function(v) v.ToString).Where(Function(v) v.StartsWithF("1.")).
Select(Of Integer)(Function(v) Val(v.Split(".")(1).BeforeFirst("-"))).Where(Function(v) v > 0).
Distinct.OrderByDescending(Function(v) v).ToList
Drops = If(CType(If(Data("game_versions"), Data("versions")), JArray), New JArray).
Select(Function(v) McVersion.VersionToDrop(v)).Where(Function(v) v > 0).Distinct.OrderByDescending(Function(v) v).ToList
'Type
Select Case Data("project_type").ToString
Case "modpack" : Type = CompType.ModPack
@@ -523,58 +525,60 @@
Json("DownloadCount") = DownloadCount
If ModLoaders IsNot Nothing AndAlso ModLoaders.Any Then Json("ModLoaders") = New JArray(ModLoaders.Select(Function(m) CInt(m)))
Json("Tags") = New JArray(Tags)
If Not String.IsNullOrEmpty(LogoUrl) Then Json("LogoUrl") = LogoUrl
If GameVersions.Any Then Json("GameVersions") = New JArray(GameVersions)
If LogoUrl IsNot Nothing Then Json("LogoUrl") = LogoUrl
If Drops.Any Then Json("Drops") = New JArray(Drops)
Json("CacheTime") = Date.Now '用于检查缓存时间
Return Json
End Function
''' <summary>
''' 将当前工程信息实例化为控件。
''' </summary>
Public Function ToCompItem(ShowMcVersionDesc As Boolean, ShowLoaderDesc As Boolean) As MyCompItem
Public Function ToCompItem(ShowMcVersionDesc As Boolean, ShowLoaderDesc As Boolean) As MyVirtualizingElement(Of MyCompItem)
'获取版本描述
Dim GameVersionDescription As String
If GameVersions Is Nothing OrElse Not GameVersions.Any() Then
If Drops Is Nothing OrElse Not Drops.Any() Then
GameVersionDescription = "仅快照版本" '#5412
Else
Dim SpaVersions As New List(Of String)
Dim Segments As New List(Of String)
Dim IsOld As Boolean = False
For i = 0 To GameVersions.Count - 1 '版本号一定为降序
For i = 0 To Drops.Count - 1 '版本号一定为降序
'获取当前连续的版本号段
Dim StartVersion As Integer = GameVersions(i), EndVersion As Integer = GameVersions(i)
If StartVersion < 10 Then '如果支持新版本，则不显示 1.9-
If SpaVersions.Any() AndAlso Not IsOld Then
Dim StartDrop As Integer = Drops(i), EndDrop As Integer = Drops(i)
If StartDrop < 100 Then '如果支持新版本，则不显示 1.9-
If Segments.Any() AndAlso Not IsOld Then
Exit For
Else
IsOld = True
End If
End If
For ii = i + 1 To GameVersions.Count - 1
If GameVersions(ii) <> EndVersion - 1 Then Exit For
EndVersion = GameVersions(ii)
For ii = i + 1 To Drops.Count - 1
If AllDrops Is Nothing OrElse AllDrops.IndexOf(Drops(ii)) <> AllDrops.IndexOf(EndDrop) + 1 Then Exit For
EndDrop = Drops(ii)
i = ii
Next
'将版本号段转为描述文本
If StartVersion = EndVersion Then
SpaVersions.Add("1." & StartVersion)
ElseIf McVersionHighest > -1 AndAlso StartVersion >= McVersionHighest Then
If EndVersion < 10 Then
SpaVersions.Clear()
SpaVersions.Add("全版本")
Dim StartName = McVersion.DropToVersion(StartDrop)
Dim EndName = McVersion.DropToVersion(EndDrop)
If StartDrop = EndDrop Then
Segments.Add(StartName)
ElseIf AllDrops?.Any AndAlso StartDrop >= AllDrops.First Then
If EndDrop < 100 Then
Segments.Clear()
Segments.Add("全版本")
Exit For
Else
SpaVersions.Add("1." & EndVersion & "+")
Segments.Add(EndName & "+")
End If
ElseIf EndVersion < 10 Then
SpaVersions.Add("1." & StartVersion & "-")
ElseIf EndDrop < 100 Then
Segments.Add(StartName & "-")
Exit For
ElseIf StartVersion - EndVersion = 1 Then
SpaVersions.Add("1." & StartVersion & ", 1." & EndVersion)
ElseIf AllDrops Is Nothing OrElse AllDrops.IndexOf(EndDrop) - AllDrops.IndexOf(StartDrop) = 1 Then
Segments.Add(StartName & ", " & EndName)
Else
SpaVersions.Add("1." & StartVersion & "~1." & EndVersion)
Segments.Add(StartName & "~" & EndName)
End If
Next
GameVersionDescription = SpaVersions.Join(", ")
GameVersionDescription = Segments.Join(", ")
End If
'获取 Mod 加载器描述
Dim ModLoaderDescriptionFull As String, ModLoaderDescriptionPart As String
@@ -593,11 +597,11 @@
ModLoaderDescriptionFull = "仅 " & ModLoadersForDesc.Single.ToString
ModLoaderDescriptionPart = ModLoadersForDesc.Single.ToString
Case Else
Dim MaxVersion As Integer = If(GameVersions.Any, GameVersions.Max, 99)
Dim NewestDrop As Integer = If(Drops.Any, Drops.First, 9999)
If ModLoaders.Contains(CompModLoaderType.Forge) AndAlso
(MaxVersion < 14 OrElse ModLoaders.Contains(CompModLoaderType.Fabric)) AndAlso
(MaxVersion < 20 OrElse ModLoaders.Contains(CompModLoaderType.NeoForge)) AndAlso
(MaxVersion < 14 OrElse ModLoaders.Contains(CompModLoaderType.Quilt) OrElse Setup.Get("ToolDownloadIgnoreQuilt")) Then
(NewestDrop < 140 OrElse ModLoaders.Contains(CompModLoaderType.Fabric)) AndAlso
(NewestDrop < 200 OrElse ModLoaders.Contains(CompModLoaderType.NeoForge)) AndAlso
(NewestDrop < 140 OrElse ModLoaders.Contains(CompModLoaderType.Quilt) OrElse Setup.Get("ToolDownloadIgnoreQuilt")) Then
ModLoaderDescriptionFull = "任意"
ModLoaderDescriptionPart = ""
Else
@@ -606,55 +610,60 @@
End If
End Select
'实例化 UI
Dim NewItem As New MyCompItem With {.Tag = Me, .Logo = GetControlLogo()}
Dim Title = GetControlTitle(True)
NewItem.Title = Title.Key
If Title.Value = "" Then
CType(NewItem.LabTitleRaw.Parent, StackPanel).Children.Remove(NewItem.LabTitleRaw)
Else
NewItem.SubTitle = Title.Value
End If
NewItem.Tags = Tags
NewItem.Description = Description.Replace(vbCr, "").Replace(vbLf, "")
'下边栏
If Not ShowMcVersionDesc AndAlso Not ShowLoaderDesc Then
'全部隐藏
CType(NewItem.PathVersion.Parent, Grid).Children.Remove(NewItem.PathVersion)
CType(NewItem.LabVersion.Parent, Grid).Children.Remove(NewItem.LabVersion)
NewItem.ColumnVersion1.Width = New GridLength(0)
NewItem.ColumnVersion2.MaxWidth = 0
NewItem.ColumnVersion3.Width = New GridLength(0)
ElseIf ShowMcVersionDesc AndAlso ShowLoaderDesc Then
'全部显示
NewItem.LabVersion.Text = If(ModLoaderDescriptionPart = "", "", ModLoaderDescriptionPart & " ") & GameVersionDescription
ElseIf ShowMcVersionDesc Then
'仅显示版本
NewItem.LabVersion.Text = GameVersionDescription
Else
'仅显示 Mod 加载器
NewItem.LabVersion.Text = ModLoaderDescriptionFull
End If
NewItem.LabSource.Text = If(FromCurseForge, "CurseForge", "Modrinth")
If LastUpdate IsNot Nothing Then
NewItem.LabTime.Text = GetTimeSpanString(LastUpdate - Date.Now, True)
Else
NewItem.LabTime.Visibility = Visibility.Collapsed
NewItem.ColumnTime1.Width = New GridLength(0)
NewItem.ColumnTime2.Width = New GridLength(0)
NewItem.ColumnTime3.Width = New GridLength(0)
End If
NewItem.LabDownload.Text =
If(DownloadCount > 100000000, Math.Round(DownloadCount / 100000000, 2) & " 亿",
If(DownloadCount > 100000, Math.Floor(DownloadCount / 10000) & " 万", DownloadCount))
Return NewItem
Return New MyVirtualizingElement(Of MyCompItem)(
Function()
Dim NewItem As New MyCompItem With {.Tag = Me}
ApplyLogoToMyImage(NewItem.PathLogo)
Dim Title = GetControlTitle(True)
NewItem.Title = Title.Key
If Title.Value = "" Then
CType(NewItem.LabTitleRaw.Parent, StackPanel).Children.Remove(NewItem.LabTitleRaw)
Else
NewItem.SubTitle = Title.Value
End If
NewItem.Tags = Tags
NewItem.Description = Description.Replace(vbCr, "").Replace(vbLf, "")
'下边栏
If Not ShowMcVersionDesc AndAlso Not ShowLoaderDesc Then
'全部隐藏
CType(NewItem.PathVersion.Parent, Grid).Children.Remove(NewItem.PathVersion)
CType(NewItem.LabVersion.Parent, Grid).Children.Remove(NewItem.LabVersion)
NewItem.ColumnVersion1.Width = New GridLength(0)
NewItem.ColumnVersion2.MaxWidth = 0
NewItem.ColumnVersion3.Width = New GridLength(0)
ElseIf ShowMcVersionDesc AndAlso ShowLoaderDesc Then
'全部显示
NewItem.LabVersion.Text = If(ModLoaderDescriptionPart = "", "", ModLoaderDescriptionPart & " ") & GameVersionDescription
ElseIf ShowMcVersionDesc Then
'仅显示版本
NewItem.LabVersion.Text = GameVersionDescription
Else
'仅显示 Mod 加载器
NewItem.LabVersion.Text = ModLoaderDescriptionFull
End If
NewItem.LabSource.Text = If(FromCurseForge, "CurseForge", "Modrinth")
If LastUpdate IsNot Nothing Then
NewItem.LabTime.Text = GetTimeSpanString(LastUpdate - Date.Now, True)
Else
NewItem.LabTime.Visibility = Visibility.Collapsed
NewItem.ColumnTime1.Width = New GridLength(0)
NewItem.ColumnTime2.Width = New GridLength(0)
NewItem.ColumnTime3.Width = New GridLength(0)
End If
NewItem.LabDownload.Text =
If(DownloadCount > 100000000, Math.Round(DownloadCount / 100000000, 2) & " 亿",
If(DownloadCount > 100000, Math.Floor(DownloadCount / 10000) & " 万", DownloadCount))
Return NewItem
End Function) With {.Height = 64}
End Function
Public Function GetControlLogo() As String
Public Sub ApplyLogoToMyImage(Img As MyImage)
If String.IsNullOrEmpty(LogoUrl) Then
Return PathImage & "Icons/NoIcon.png"
Img.Source = PathImage & "Icons/NoIcon.png"
Else
Return LogoUrl
Img.Source = LogoUrl
Img.FallbackSource = DlSourceModGet(LogoUrl)
End If
End Function
End Sub
Public Function GetControlTitle(HasModLoaderDescription As Boolean) As KeyValuePair(Of String, String)
'检查下列代码时可以参考 #1567 的测试例
Dim Title As String = RawName
@@ -755,7 +764,7 @@ NoSubtitle:
'Mod 加载器一致
If ModLoaders.Count <> Project.ModLoaders.Count OrElse ModLoaders.Except(Project.ModLoaders).Any() Then Return False
'若不为光影，则要求 MC 版本一致
If Type <> CompType.Shader AndAlso (GameVersions.Count <> Project.GameVersions.Count OrElse GameVersions.Except(Project.GameVersions).Any()) Then Return False
If Type <> CompType.Shader AndAlso (Drops.Count <> Project.Drops.Count OrElse Drops.Except(Project.Drops).Any()) Then Return False
'最近更新时间差距在一周以内
If LastUpdate IsNot Nothing AndAlso Project.LastUpdate IsNot Nothing AndAlso
Math.Abs((LastUpdate - Project.LastUpdate).Value.TotalDays) > 7 Then Return False
@@ -967,7 +976,7 @@ NoSubtitle:
#Region "拒绝 1.13- Quilt（这个版本根本没有 Quilt）"
If Request.ModLoader = CompModLoaderType.Quilt AndAlso VersionSortInteger(If(Request.GameVersion, "1.15"), "1.14") = -1 Then
If Request.ModLoader = CompModLoaderType.Quilt AndAlso CompareVersion(If(Request.GameVersion, "1.15"), "1.14") = -1 Then
Throw New Exception("Quilt 不支持 Minecraft " & Request.GameVersion)
End If
@@ -1060,7 +1069,7 @@ Retry:
'在 1.14-，部分老 Mod 没有设置支持的加载器，因此添加 Forge 筛选就会出现遗漏
'所以，在发起请求时不筛选加载器，然后在返回的结果中自行筛除不是 Forge 的 Mod
Dim IsOldForgeRequest = Request.ModLoader = CompModLoaderType.Forge AndAlso Request.GameVersion?.Contains(".") AndAlso Val(Request.GameVersion.Split(".")(1)) < 14
Dim IsOldForgeRequest = Request.ModLoader = CompModLoaderType.Forge AndAlso McVersion.VersionToDrop(Request.GameVersion, True) < 140
If IsOldForgeRequest Then Request.ModLoader = CompModLoaderType.Any
Dim CurseForgeUrl As String = Request.GetCurseForgeAddress()
Dim ModrinthUrl As String = Request.GetModrinthAddress()
@@ -1176,9 +1185,9 @@ Retry:
#Region "提取非重复项，存储于 RealResults"
'将 Modrinth 排在 CurseForge 的前面，避免加载结束顺序不同导致排名不同
'这样做的话，去重后将优先保留 CurseForge 内容
RawResults = RawResults.Where(Function(x) Not x.FromCurseForge).Concat(RawResults.Where(Function(x) x.FromCurseForge)).ToList
'将 CurseForge 排在 Modrinth 的前面，避免加载结束顺序不同导致排名不同
'这样做的话，去重后将优先保留 Modrinth 的内容
RawResults = RawResults.Where(Function(x) x.FromCurseForge).Concat(RawResults.Where(Function(x) Not x.FromCurseForge)).ToList
'RawResults 去重
RawResults = RawResults.Distinct(Function(a, b) a.IsLike(b))
'已有内容去重
@@ -1292,11 +1301,16 @@ Retry:
''' </summary>
Public ReadOnly DownloadCount As Integer
''' <summary>
''' Mod 版本号。
''' 不一定是标准格式。CurseForge 上默认为 Nothing。
''' </summary>
Public Version As String
''' <summary>
''' 支持的 Mod 加载器列表。可能为空。
''' </summary>
Public ReadOnly ModLoaders As List(Of CompModLoaderType)
''' <summary>
''' 支持的游戏版本列表。类型包括："1.18.5"，"1.18"，"1.18 预览版"，"21w15a"，"未知版本"。
''' 支持的游戏版本列表。类型包括："26.1.5"，"26.1"，"26.1 预览版"，"1.18.5"，"1.18"，"1.18 预览版"，"21w15a"，"未知版本"。
''' </summary>
Public ReadOnly GameVersions As List(Of String)
''' <summary>
@@ -1369,6 +1383,7 @@ Retry:
FromCurseForge = Data("FromCurseForge").ToObject(Of Boolean)
Id = Data("Id").ToString
DisplayName = Data("DisplayName").ToString
If Data.ContainsKey("Version") Then Version = Data("Version").ToString
ReleaseDate = Data("ReleaseDate").ToObject(Of Date)
DownloadCount = Data("DownloadCount").ToObject(Of Integer)
Status = CType(Data("Status").ToObject(Of Integer), CompFileStatus)
@@ -1387,6 +1402,7 @@ Retry:
'简单信息
Id = Data("id")
DisplayName = Data("displayName").ToString.Replace(" ", "").Trim(" ")
Version = Nothing
ReleaseDate = Data("fileDate")
Status = CType(Data("releaseType").ToObject(Of Integer), CompFileStatus)
DownloadCount = Data("downloadCount")
@@ -1408,9 +1424,9 @@ Retry:
End If
'GameVersions
Dim RawVersions As List(Of String) = Data("gameVersions").Select(Function(t) t.ToString.Trim.ToLower).ToList
GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.")).Select(Function(v) v.Replace("-snapshot", " 预览版")).ToList
GameVersions = RawVersions.Where(Function(v) McVersion.IsFormatFit(v)).Select(Function(v) v.Replace("-snapshot", " 预览版")).ToList
If GameVersions.Count > 1 Then
GameVersions = GameVersions.Sort(AddressOf VersionSortBoolean).ToList
GameVersions = GameVersions.SortByComparison(AddressOf CompareVersionGE).ToList
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)} '整合包理应只 “支持” 一个版本
ElseIf GameVersions.Count = 1 Then
GameVersions = GameVersions.ToList
@@ -1429,6 +1445,7 @@ Retry:
'简单信息
Id = Data("id")
DisplayName = Data("name").ToString.Replace(" ", "").Trim(" ")
Version = Data("version_number")
ReleaseDate = Data("date_published")
Status = If(Data("version_type").ToString = "release", CompFileStatus.Release, If(Data("version_type").ToString = "beta", CompFileStatus.Beta, CompFileStatus.Alpha))
DownloadCount = Data("downloads")
@@ -1467,15 +1484,15 @@ Retry:
End If
'GameVersions
Dim RawVersions As List(Of String) = Data("game_versions").Select(Function(t) t.ToString.Trim.ToLower).ToList
GameVersions = RawVersions.Where(Function(v) v.StartsWithF("1.") OrElse v.StartsWithF("b1.")).
GameVersions = RawVersions.Where(Function(v) v.Contains(".")).
Select(Function(v) If(v.Contains("-"), v.BeforeFirst("-") & " 预览版", If(v.StartsWithF("b1."), "远古版本", v))).ToList
If GameVersions.Count > 1 Then
GameVersions = GameVersions.Sort(AddressOf VersionSortBoolean).ToList
GameVersions = GameVersions.SortByComparison(AddressOf CompareVersionGE).ToList
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)} '整合包理应只 “支持” 一个版本
ElseIf GameVersions.Count = 1 Then
'无需处理
ElseIf RawVersions.Any(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]{1}")) Then
GameVersions = RawVersions.Where(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]{1}")).ToList
ElseIf RawVersions.Any(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]")) Then
GameVersions = RawVersions.Where(Function(v) RegexCheck(v, "[0-9]{2}w[0-9]{2}[a-z]")).ToList
Else
GameVersions = New List(Of String) From {"未知版本"}
End If
@@ -1504,6 +1521,7 @@ Retry:
Dim Json As New JObject
Json.Add("FromCurseForge", FromCurseForge)
Json.Add("Id", Id)
If Version IsNot Nothing Then Json.Add("Version", Version)
Json.Add("DisplayName", DisplayName)
Json.Add("ReleaseDate", ReleaseDate)
Json.Add("DownloadCount", DownloadCount)
@@ -1521,56 +1539,56 @@ Retry:
''' 将当前文件信息实例化为控件。
''' </summary>
Public Function ToListItem(OnClick As MyListItem.ClickEventHandler, Optional OnSaveClick As MyIconButton.ClickEventHandler = Nothing,
Optional BadDisplayName As Boolean = False) As MyListItem
Optional BadDisplayName As Boolean = False) As MyVirtualizingElement(Of MyListItem)
Return New MyVirtualizingElement(Of MyListItem)(
Function()
'获取描述信息
Dim Title As String = If(BadDisplayName, FileName, DisplayName)
Dim Info As New List(Of String)
If Title <> FileName.BeforeLast(".") Then Info.Add(FileName.BeforeLast("."))
If Dependencies.Any Then Info.Add(Dependencies.Count & " 项前置")
If GameVersions.All(
Function(VerName)
Return Not VerName.Contains(".") OrElse {"w", "snapshot", "rc", "pre", "experimental", "-"}.Any(Function(s) VerName.ContainsF(s, True))
End Function) Then Info.Add($"游戏版本 {Join(GameVersions, "、")}")
If DownloadCount > 0 Then 'CurseForge 的下载次数经常错误地返回 0
Info.Add("下载 " & If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次", DownloadCount & " 次"))
End If
Info.Add("更新于 " & GetTimeSpanString(ReleaseDate - Date.Now, False))
If Status <> CompFileStatus.Release Then Info.Add(StatusDescription)
'获取描述信息
Dim Title As String = If(BadDisplayName, FileName, DisplayName)
Dim Info As New List(Of String)
If Title <> FileName.BeforeLast(".") Then Info.Add(FileName.BeforeLast("."))
If Dependencies.Any Then Info.Add(Dependencies.Count & " 项前置")
If GameVersions.All(Function(v) Not IsVersionNameLikeRelease(v)) Then Info.Add($"游戏版本 {Join(GameVersions, "、")}")
If DownloadCount > 0 Then 'CurseForge 的下载次数经常错误地返回 0
Info.Add("下载 " & If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次", DownloadCount & " 次"))
End If
Info.Add("更新于 " & GetTimeSpanString(ReleaseDate - Date.Now, False))
If Status <> CompFileStatus.Release Then Info.Add(StatusDescription)
'建立控件
Dim NewItem As New MyListItem With {
.Title = Title,
.SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Me,
.Info = Info.Join("，")
}
Select Case Status
Case CompFileStatus.Release
NewItem.Logo = PathImage & "Icons/R.png"
Case CompFileStatus.Beta
NewItem.Logo = PathImage & "Icons/B.png"
Case Else 'Alpha
NewItem.Logo = PathImage & "Icons/A.png"
End Select
AddHandler NewItem.Click, OnClick
'建立控件
Dim NewItem As New MyListItem With {
.Title = Title,
.SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Me,
.Info = Info.Join("，")
}
Select Case Status
Case CompFileStatus.Release
NewItem.Logo = PathImage & "Icons/R.png"
Case CompFileStatus.Beta
NewItem.Logo = PathImage & "Icons/B.png"
Case Else 'Alpha
NewItem.Logo = PathImage & "Icons/A.png"
End Select
AddHandler NewItem.Click, OnClick
'建立另存为按钮
If OnSaveClick IsNot Nothing Then
Dim BtnSave As New MyIconButton With {.Logo = Logo.IconButtonSave, .ToolTip = "另存为"}
ToolTipService.SetPlacement(BtnSave, Primitives.PlacementMode.Center)
ToolTipService.SetVerticalOffset(BtnSave, 30)
ToolTipService.SetHorizontalOffset(BtnSave, 2)
AddHandler BtnSave.Click, OnSaveClick
NewItem.Buttons = {BtnSave}
End If
'结束
Return NewItem
'建立另存为按钮
If OnSaveClick IsNot Nothing Then
Dim BtnSave As New MyIconButton With {.Logo = Logo.IconButtonSave, .ToolTip = "另存为"}
ToolTipService.SetPlacement(BtnSave, Primitives.PlacementMode.Center)
ToolTipService.SetVerticalOffset(BtnSave, 30)
ToolTipService.SetHorizontalOffset(BtnSave, 2)
AddHandler BtnSave.Click, OnSaveClick
NewItem.Buttons = {BtnSave}
End If
Return NewItem
End Function) With {.Height = 42}
End Function
'辅助函数
Public Overrides Function ToString() As String
Return $"{Id}: {FileName}"
End Function
End Class
'获取
Plain Craft Launcher 2/Modules/Minecraft/ModCrash.vb
+7 -7
View File
@@ -2,9 +2,9 @@
'构造函数
Private TempFolder As String
Private TargetVersion As McVersion
Public Sub New(Optional TargetVersion As McVersion = Nothing)
Me.TargetVersion = TargetVersion
Private TargetInstance As McInstance
Public Sub New(Optional TargetInstance As McInstance = Nothing)
Me.TargetInstance = TargetInstance
'构建文件结构
TempFolder = RequestTaskTempFolder()
Directory.CreateDirectory(TempFolder & "Temp\")
@@ -391,7 +391,7 @@ Extracted:
''' <summary>
''' 根据 AnalyzeLogs 与可能的版本信息分析崩溃原因。
''' </summary>
Public Sub Analyze(Optional Version As McVersion = Nothing)
Public Sub Analyze()
Log("[Crash] 步骤 3：分析崩溃原因")
LogAll = If(LogMc, If(LogMcDebug, "")) & If(LogHs, "") & If(LogCrash, "")
@@ -538,7 +538,7 @@ Done:
'确定的 Mod 导致崩溃
If LogMc.Contains("Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(RegexSeek(LogMc, "(?<=Caught exception from )[^\n]+?")?.TrimEnd((vbCrLf & " ").ToCharArray)))
'Mod 重复 / 前置问题
If LogMc.Contains("DuplicateModsFoundException") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=\n\t[\w]+ : [A-Z]{1}:[^\n]+(/|\\))[^/\\\n]+?.jar", RegularExpressions.RegexOptions.IgnoreCase))
If LogMc.Contains("DuplicateModsFoundException") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=\n\t[\w]+ : [A-Z]:[^\n]+(/|\\))[^/\\\n]+?.jar", RegularExpressions.RegexOptions.IgnoreCase))
If LogMc.Contains("Found a duplicate mod") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "Found a duplicate mod[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase))
If LogMc.Contains("Found duplicate mods") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(LogMc, "(?<=Mod ID: ')\w+?(?=' from mod files:)").Distinct.ToList)
If LogMc.Contains("ModResolutionException: Duplicate") Then AppendReason(CrashReason.Mod重复安装, RegexSearch(If(RegexSeek(LogMc, "ModResolutionException: Duplicate[^\n]+"), ""), "[^\\/]+.jar", RegularExpressions.RegexOptions.IgnoreCase))
@@ -607,7 +607,7 @@ Done:
Return True
End If
'JSON 名称匹配
For Each JsonName In RegexSearch(LogText, "(?<=^[^\t]+[ \[{(]{1})[^ \[{(]+\.[^ ]+(?=\.json)", RegularExpressions.RegexOptions.Multiline)
For Each JsonName In RegexSearch(LogText, "(?<=^[^\t]+[ \[{(])[^ \[{(]+\.[^ ]+(?=\.json)", RegularExpressions.RegexOptions.Multiline)
AppendReason(CrashReason.ModMixin失败,
TryAnalyzeModName(JsonName.Replace("mixins", "mixin").Replace(".mixin", "").Replace("mixin.", "")))
Return True
@@ -926,7 +926,7 @@ NextStack:
'上报
If IsManualAnalyze Then Return
Telemetry("Minecraft 崩溃",
"Version", If(TargetVersion Is Nothing, "null", TargetVersion.Version.ToString),
"Version", If(TargetInstance Is Nothing, "null", TargetInstance.VersionDisplayName),
"Detail", FilterUserName(Detail, "*"))
End Sub
''' <summary>
Plain Craft Launcher 2/Modules/Minecraft/ModDownload.vb
+159 -120
View File
@@ -6,40 +6,40 @@
''' 返回某 Minecraft 版本对应的原版主 Jar 文件的下载信息，要求对应依赖版本已存在。
''' 失败则抛出异常，不需要下载则返回 Nothing。
''' </summary>
Public Function DlClientJarGet(Version As McVersion, ReturnNothingOnFileUseable As Boolean) As NetFile
Public Function DlClientJarGet(Instance As McInstance, ReturnNothingOnFileUseable As Boolean) As NetFile
'获取底层继承版本
Try
Do While Not String.IsNullOrEmpty(Version.InheritVersion)
Version = New McVersion(Version.InheritVersion)
Do While Not String.IsNullOrEmpty(Instance.InheritName)
Instance = New McInstance(Instance.InheritName)
Loop
Catch ex As Exception
Log(ex, "获取底层继承版本失败")
End Try
'检查 Json 是否标准
If Version.JsonObject("downloads") Is Nothing OrElse Version.JsonObject("downloads")("client") Is Nothing OrElse Version.JsonObject("downloads")("client")("url") Is Nothing Then
Throw New Exception("底层版本 " & Version.Name & " 中无 jar 文件下载信息")
If Instance.JsonObject("downloads") Is Nothing OrElse Instance.JsonObject("downloads")("client") Is Nothing OrElse Instance.JsonObject("downloads")("client")("url") Is Nothing Then
Throw New Exception("底层版本 " & Instance.Name & " 中无 jar 文件下载信息")
End If
'检查文件
Dim Checker As New FileChecker(MinSize:=1024, ActualSize:=If(Version.JsonObject("downloads")("client")("size"), -1), Hash:=Version.JsonObject("downloads")("client")("sha1"))
If ReturnNothingOnFileUseable AndAlso Checker.Check(Version.Path & Version.Name & ".jar") Is Nothing Then Return Nothing '通过校验
Dim Checker As New FileChecker(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 = Version.JsonObject("downloads")("client")("url")
Return New NetFile(DlSourceLauncherOrMetaGet(JarUrl), Version.Path & Version.Name & ".jar", Checker)
Dim JarUrl As String = Instance.JsonObject("downloads")("client")("url")
Return New NetFile(DlSourceLauncherOrMetaGet(JarUrl), Instance.PathVersion & Instance.Name & ".jar", Checker)
End Function
''' <summary>
''' 返回某 Minecraft 版本对应的原版主 AssetIndex 文件的下载信息，要求对应依赖版本已存在。
''' 若未找到，则会返回 Legacy 资源文件或 Nothing。
''' </summary>
Public Function DlClientAssetIndexGet(Version As McVersion) As NetFile
Public Function DlClientAssetIndexGet(Instance As McInstance) As NetFile
'获取底层继承版本
Do While Not String.IsNullOrEmpty(Version.InheritVersion)
Version = New McVersion(Version.InheritVersion)
Do While Not String.IsNullOrEmpty(Instance.InheritName)
Instance = New McInstance(Instance.InheritName)
Loop
'获取信息
Dim IndexInfo = McAssetsGetIndex(Version, True, True)
Dim IndexAddress As String = PathMcFolder & "assets\indexes\" & IndexInfo("id").ToString & ".json"
Log("[Download] 版本 " & Version.Name & " 对应的资源文件索引为 " & IndexInfo("id").ToString)
Dim IndexInfo = McAssetsGetIndex(Instance, True, True)
Dim IndexAddress As String = McFolderSelected & "assets\indexes\" & IndexInfo("id").ToString & ".json"
Log("[Download] 版本 " & Instance.Name & " 对应的资源文件索引为 " & IndexInfo("id").ToString)
Dim IndexUrl As String = If(IndexInfo("url"), "")
If IndexUrl = "" Then
Return Nothing
@@ -51,12 +51,12 @@
''' <summary>
''' 构造补全某 Minecraft 版本的所有文件的加载器列表。失败会抛出异常。
''' </summary>
Public Function DlClientFix(Version As McVersion, CheckAssetsHash As Boolean, AssetsIndexBehaviour As AssetsIndexExistsBehaviour) As List(Of LoaderBase)
Public Function DlClientFix(Instance As McInstance, CheckAssetsHash As Boolean, AssetsIndexBehaviour As AssetsIndexExistsBehaviour) As List(Of LoaderBase)
Dim Loaders As New List(Of LoaderBase)
#Region "下载支持库文件"
Dim LoadersLib As New List(Of LoaderBase) From {
New LoaderTask(Of String, List(Of NetFile))("分析缺失支持库文件", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(Version)) With {.ProgressWeight = 1},
New LoaderTask(Of String, List(Of NetFile))("分析缺失支持库文件", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibNetFilesFromInstance(Instance)) With {.ProgressWeight = 1},
New LoaderDownload("下载支持库文件", New List(Of NetFile)) With {.ProgressWeight = 15}
}
'构造加载器
@@ -64,7 +64,7 @@
#End Region
#Region "下载资源文件"
If ShouldIgnoreFileCheck(Version) Then
If ShouldIgnoreFileCheck(Instance) Then
Log("[Download] 已跳过所有 Assets 检查")
Else
Dim LoadersAssets As New List(Of LoaderBase)
@@ -72,10 +72,10 @@
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析资源文件索引地址",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Try
Dim IndexFile = DlClientAssetIndexGet(Version)
Dim IndexFile = DlClientAssetIndexGet(Instance)
If IndexFile Is Nothing Then
Task.Output = New List(Of NetFile)
Log("[Download] 未找到版本 " & Version.Name & " 的合适的资源索引下载地址，游戏 assets 可能缺失", LogLevel.Debug)
Log("[Download] 未找到版本 " & Instance.Name & " 的合适的资源索引下载地址，游戏 assets 可能缺失", LogLevel.Debug)
ElseIf AssetsIndexBehaviour <> AssetsIndexExistsBehaviour.AlwaysDownload AndAlso IndexFile.Check.Check(IndexFile.LocalPath) Is Nothing Then
Task.Output = New List(Of NetFile)
Else
@@ -94,9 +94,9 @@
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(Version)
Dim BackAssetsFile As NetFile = DlClientAssetIndexGet(Instance)
If BackAssetsFile Is Nothing Then
Log("[Download] 未找到版本 " & Version.Name & " 的合适的资源索引下载地址，游戏 assets 可能缺失", LogLevel.Debug)
Log("[Download] 未找到版本 " & Instance.Name & " 的合适的资源索引下载地址，游戏 assets 可能缺失", LogLevel.Debug)
Task.Abort()
Throw New ThreadInterruptedException
End If
@@ -121,14 +121,12 @@
Updater.Start()
End If
'获取资源文件地址
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析缺失资源文件",
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
Task.Output = McAssetsFixList(Version, CheckAssetsHash, Task)
End Sub) With {.ProgressWeight = 3})
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 = 30.5})
Loaders.Add(New LoaderCombo(Of String)("下载资源文件（主加载器）", LoadersAssets) With {.Block = False, .Show = False, .ProgressWeight = 27})
End If
#End Region
@@ -153,6 +151,23 @@
#Region "DlClientList | Minecraft 客户端 版本列表"
''' <summary>
''' 所有正式版的 Minecraft Drop 序数，按从高到低排列。
''' Nothing 代表从未完成过获取。
''' </summary>
Public Property AllDrops As List(Of Integer)
Get
If _AllDrops Is Nothing Then _AllDrops = Setup.Get("CacheDrops").ToString.Split(","c).Select(Function(d) CInt(d)).ToList()
If Not _AllDrops.Any Then _AllDrops = Nothing
Return _AllDrops
End Get
Set(value As List(Of Integer))
_AllDrops = value
Setup.Set("CacheDrops", value.Join(","))
End Set
End Property
Private _AllDrops As List(Of Integer) = Nothing
'主加载器
Public Structure DlClientListResult
''' <summary>
@@ -167,10 +182,6 @@
''' 获取到的 Json 数据。
''' </summary>
Public Value As JObject
'''' <summary>
'''' 官方源的失败原因。若没有则为 Nothing。
'''' </summary>
'Public OfficialError As Exception
End Structure
''' <summary>
''' Minecraft 客户端 版本列表，主加载器。
@@ -195,6 +206,12 @@
New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListBmclapiLoader, 60 + 60)
}, Loader.IsForceRestarting)
End Select
'提取所有 Drop 序数
Dim Drops As New List(Of Integer)
For Each Version As JObject In Loader.Output.Value("versions")
Drops.Add(McVersion.VersionToDrop(Version("id")))
Next
AllDrops = Drops.Distinct.OrderByDescending(Function(d) d).ToList()
End Sub
'各个下载源的分加载器
@@ -202,8 +219,6 @@
''' Minecraft 客户端 版本列表，Mojang 官方源加载器。
''' </summary>
Public DlClientListMojangLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Mojang", AddressOf DlClientListMojangMain)
Private IsNewClientVersionHinted As Boolean = False
Private ReadOnly HintLock As New Object() ' 线程安全锁
Private Sub DlClientListMojangMain(Loader As LoaderTask(Of String, DlClientListResult))
Dim StartTime As Long = GetTimeTick()
Dim Json As JObject = GetJson(NetRequestByClientRetry("https://launchermeta.mojang.com/mc/game/version_manifest.json", RequireJson:=True))
@@ -220,29 +235,25 @@
If File.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(ReadFile(PathTemp & "Cache\download.json")))
'返回
Loader.Output = New DlClientListResult With {.IsOfficial = True, .SourceName = "Mojang 官方源", .Value = Json}
'解析更新提示（Release）
Dim Version As String = Json("latest")("release")
If Setup.Get("ToolUpdateRelease") AndAlso Not Setup.Get("ToolUpdateReleaseLast") = "" AndAlso Version IsNot Nothing AndAlso Not Setup.Get("ToolUpdateReleaseLast") = Version Then
SyncLock HintLock
If Not IsNewClientVersionHinted Then ' 在锁内再次检查
McDownloadClientUpdateHint(Version, Json)
IsNewClientVersionHinted = True
End If
End SyncLock
End If
McVersionHighest = Version.Split(".")(1)
Setup.Set("ToolUpdateReleaseLast", Version)
'解析更新提示（Snapshot）
'MC 更新提示
Static IsHinted As Boolean = False
Dim Version As String
'快照版
Version = Json("latest")("snapshot")
If Setup.Get("ToolUpdateSnapshot") AndAlso Not Setup.Get("ToolUpdateSnapshotLast") = "" AndAlso Version IsNot Nothing AndAlso Not Setup.Get("ToolUpdateSnapshotLast") = Version Then
SyncLock HintLock
If Not IsNewClientVersionHinted Then ' 在锁内再次检查
McDownloadClientUpdateHint(Version, Json)
IsNewClientVersionHinted = True
End If
End SyncLock
If Setup.Get("ToolUpdateSnapshot") AndAlso Not Setup.Get("ToolUpdateSnapshotLast") = "" AndAlso
Setup.Get("ToolUpdateSnapshotLast") <> Version AndAlso Not IsHinted Then
IsHinted = True
McDownloadClientUpdateHint(Version, Json)
End If
Setup.Set("ToolUpdateSnapshotLast", If(Version, "Nothing"))
'正式版
Version = Json("latest")("release")
If Setup.Get("ToolUpdateRelease") AndAlso Not Setup.Get("ToolUpdateReleaseLast") = "" AndAlso
Setup.Get("ToolUpdateReleaseLast") <> Version AndAlso Not IsHinted Then
IsHinted = True
McDownloadClientUpdateHint(Version, Json)
End If
Setup.Set("ToolUpdateReleaseLast", Version)
Catch ex As Exception
Throw New Exception("Minecraft 官方源版本列表解析失败", ex)
End Try
@@ -329,15 +340,15 @@
''' <summary>
''' 显示名称，已去除 HD_U 字样，如“1.12.2 C8”。
''' </summary>
Public NameDisplay As String
Public DisplayName As String
''' <summary>
''' 原始文件名称，如“preview_OptiFine_1.11_HD_U_E1_pre.jar”。
''' </summary>
Public NameFile As String
Public FileName As String
''' <summary>
''' 对应的版本名称，如“1.13.2-OptiFine_HD_U_E6”。
''' </summary>
Public NameVersion As String
Public InstanceName As String
''' <summary>
''' 是否为测试版。
''' </summary>
@@ -409,14 +420,14 @@
For i = 0 To ReleaseTime.Count - 1
Name(i) = Name(i).Replace("_", " ")
Dim Entry As New DlOptiFineListEntry With {
.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).ContainsF("pre", True),
.Inherit = Name(i).ToString.Split(" ")(0),
.NameFile = If(Name(i).ContainsF("pre", True), "preview_", "") & "OptiFine_" & Name(i).Replace(" ", "_") & ".jar",
.RequiredForgeVersion = Forge(i).Replace("Forge ", "").Replace("#", "")}
.DisplayName = Name(i).Replace("HD U ", "").Replace(".0 ", " "),
.ReleaseTime = Join({ReleaseTime(i).Split(".")(2), ReleaseTime(i).Split(".")(1), ReleaseTime(i).Split(".")(0)}, "/"),
.IsPreview = Name(i).ContainsF("pre", True),
.Inherit = Name(i).ToString.Split(" ")(0),
.FileName = If(Name(i).ContainsF("pre", True), "preview_", "") & "OptiFine_" & Name(i).Replace(" ", "_") & ".jar",
.RequiredForgeVersion = Forge(i).Replace("Forge ", "").Replace("#", "")}
If Entry.RequiredForgeVersion.Contains("N/A") Then Entry.RequiredForgeVersion = Nothing
Entry.NameVersion = Entry.Inherit & "-OptiFine_" & Name(i).ToString.Replace(" ", "_").Replace(Entry.Inherit & "_", "")
Entry.InstanceName = Entry.Inherit & "-OptiFine_" & Name(i).ToString.Replace(" ", "_").Replace(Entry.Inherit & "_", "")
Versions.Add(Entry)
Next
Loader.Output = New DlOptiFineListResult With {.IsOfficial = True, .SourceName = "OptiFine 官方源", .Value = Versions}
@@ -435,15 +446,15 @@
Dim Versions As New List(Of DlOptiFineListEntry)
For Each Token As JObject In Json
Dim Entry As New DlOptiFineListEntry With {
.NameDisplay = (Token("mcversion").ToString & Token("type").ToString.Replace("HD_U", "").Replace("_", " ") & " " & Token("patch").ToString).Replace(".0 ", " "),
.ReleaseTime = "",
.IsPreview = Token("patch").ToString.ContainsF("pre", True),
.Inherit = Token("mcversion").ToString,
.NameFile = Token("filename").ToString,
.RequiredForgeVersion = If(Token("forge"), "").ToString.Replace("Forge ", "").Replace("#", "")
}
.DisplayName = (Token("mcversion").ToString & Token("type").ToString.Replace("HD_U", "").Replace("_", " ") & " " & Token("patch").ToString).Replace(".0 ", " "),
.ReleaseTime = "",
.IsPreview = Token("patch").ToString.ContainsF("pre", True),
.Inherit = Token("mcversion").ToString,
.FileName = Token("filename").ToString,
.RequiredForgeVersion = If(Token("forge"), "").ToString.Replace("Forge ", "").Replace("#", "")
}
If Entry.RequiredForgeVersion.Contains("N/A") Then Entry.RequiredForgeVersion = Nothing
Entry.NameVersion = Entry.Inherit & "-OptiFine_" & (Token("type").ToString & " " & Token("patch").ToString).Replace(".0 ", " ").Replace(" ", "_").Replace(Entry.Inherit & "_", "")
Entry.InstanceName = Entry.Inherit & "-OptiFine_" & (Token("type").ToString & " " & Token("patch").ToString).Replace(".0 ", " ").Replace(" ", "_").Replace(Entry.Inherit & "_", "")
Versions.Add(Entry)
Next
Loader.Output = New DlOptiFineListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Versions}
@@ -503,7 +514,7 @@
Dim Result As String = NetRequestByClientRetry("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_1.2.4.html", Encoding:=Encoding.Default, Accept:="text/html", SimulateBrowserHeaders:=True)
If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足（" & Result & "）")
'获取所有版本信息
Dim Names As List(Of String) = RegexSearch(Result, "(?<=a href=""index_)[0-9.]+(_pre[0-9]?)?(?=.html)")
Dim Names As List(Of String) = RegexSearch(Result, "(?<=a href=""index_)[0-9.]+((_pre|[_-]snapshot[_-]?)[0-9]?)?(?=.html)")
Names.Add("1.2.4") '1.2.4 不会被匹配上
If Names.Count < 10 Then Throw New Exception("获取到的版本数量不足（" & Result & "）")
Loader.Output = New DlForgeListResult With {.IsOfficial = True, .SourceName = "Forge 官方源", .Value = Names}
@@ -514,11 +525,10 @@
''' </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 = NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/minecraft", Encoding:=Encoding.Default)
If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足（" & Result & "）")
'获取所有版本信息
Dim Names As List(Of String) = RegexSearch(Result, "[0-9.]+(_pre[0-9]?)?")
If Names.Count < 10 Then Throw New Exception("获取到的版本数量不足（" & Result & "）")
Dim Result As JArray = GetJson(NetRequestByClientRetry("https://bmclapi2.bangbang93.com/forge/minecraft",
Encoding:=Encoding.Default, RequireJson:=True))
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}
End Sub
@@ -527,60 +537,47 @@
#Region "DlForgeVersion | Forge 版本列表"
Public MustInherit Class DlForgelikeEntry
Implements IComparable(Of DlForgelikeEntry)
Public IsNeoForge As Boolean
''' <summary>
''' 加载器名称。Forge 或 NeoForge。
''' </summary>
Public ReadOnly Property LoaderName As String
Get
Return If(IsNeoForge, "NeoForge", "Forge")
End Get
End Property
Public MustOverride ReadOnly Property LoaderName As String
''' <summary>
''' 文件扩展名。不以小数点开头。
''' </summary>
Public ReadOnly Property FileExtension As String
Get
If IsNeoForge Then
Return "jar"
Else
Return If(CType(Me, DlForgeVersionEntry).Category = "installer", "jar", "zip")
End If
End Get
End Property
Public MustOverride ReadOnly Property FileExtension As String
''' <summary>
''' Forge：MC 版本是否小于 1.13。
''' NeoForge：MC 版本是否为 1.20.1。
''' </summary>
Public ReadOnly Property IsLegacy As Boolean
Get
'虽然很抽象，但确实可以这样判断
'Forge：1.13+ 的版本号首位都大于 20
'NeoForge：1.20.1 的版本号首位人为规定为 19 开头
Return Version.Major < 20
End Get
End Property
''' <summary>
''' 标准化后的版本号，仅可用于比较与排序。
''' 标准化后的版本号，仅可用于比较与排序，且 NeoForge 项不包含 alpha/beta 编号！
''' 格式：Major.Minor.Build.Revision
''' Forge：如 “50.1.9.0”（最后一位固定为 0）、“14.22.1.2478”（Legacy）。
''' NeoForge：如 “20.4.30.0”（最后一位固定为 0）、“19.47.1.99”（Legacy：第一位固定为 19）。
''' </summary>
Public Version As Version
''' <summary>
''' 可对玩家显示的非格式化版本名。
''' 可读的非格式化版本名。
''' Forge：如 “50.1.9”、“14.22.1.2478”（Legacy）。
''' NeoForge：如 “20.4.30-beta”、“47.1.99”（Legacy）。
''' </summary>
Public VersionName As String
''' <summary>
''' 对应的 Minecraft 版本，如“1.12.2”。
''' 对应的 Minecraft 版本，如 1.12.2、26.1-snapshot-1。
''' </summary>
Public Inherit As String
Public Function CompareTo(other As DlForgelikeEntry) As Integer Implements IComparable(Of DlForgelikeEntry).CompareTo
If Version <> other.Version Then
Return Version.CompareTo(other.Version)
Else
Return CompareVersion(VersionName, other.VersionName)
End If
End Function
End Class
Public Class DlForgeVersionEntry
Inherits DlForgelikeEntry
''' <summary>
''' 发布时间，格式为“yyyy/MM/dd HH:mm”。
''' </summary>
@@ -602,6 +599,23 @@
''' </summary>
Public FileVersion As String
''' <summary>
''' 加载器名称。Forge 或 NeoForge。
''' </summary>
Public Overrides ReadOnly Property LoaderName As String
Get
Return "Forge"
End Get
End Property
''' <summary>
''' 文件扩展名。不以小数点开头。
''' </summary>
Public Overrides ReadOnly Property FileExtension As String
Get
Return If(Category = "installer", "jar", "zip")
End Get
End Property
Public Sub New(Version As String, Branch As String, Inherit As String)
'司马版本的特殊处理
If Version = "11.15.1.2318" OrElse Version = "11.15.1.1902" OrElse Version = "11.15.1.1890" Then Branch = "1.8.9"
@@ -613,6 +627,7 @@
Me.Inherit = Inherit
FileVersion = Version & If(Branch Is Nothing, "", "-" & Branch)
End Sub
End Class
''' <summary>
@@ -651,7 +666,7 @@
".html", SimulateBrowserHeaders:=True)
Catch ex As Exception
If ex.GetBrief().Contains("(404)") Then
Throw New Exception("不可用")
Throw New Exception("无")
Else
Throw
End If
@@ -709,7 +724,7 @@
Catch ex As Exception
Throw New Exception("Forge 官方源版本列表解析失败（" & Result & "）", ex)
End Try
If Not Versions.Any() Then Throw New Exception("不可用")
If Not Versions.Any() Then Throw New Exception("无")
Loader.Output = Versions
End Sub
@@ -718,7 +733,7 @@
''' </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
Loader.Input.Replace("-", "_"), RequireJson:=True)) '兼容 Forge 1.7.10-pre4，#4057
Dim Versions As New List(Of DlForgeVersionEntry)
Try
Dim Recommended As String = McDownloadForgeRecommendedGet(Loader.Input)
@@ -763,7 +778,7 @@
Catch ex As Exception
Throw New Exception("Forge BMCLAPI 版本列表解析失败（" & Json.ToString & "）", ex)
End Try
If Not Versions.Any() Then Throw New Exception("不可用")
If Not Versions.Any() Then Throw New Exception("无")
Loader.Output = Versions
End Sub
@@ -788,6 +803,7 @@
Public Class DlNeoForgeListEntry
Inherits DlForgelikeEntry
''' <summary>
''' 是否是 Beta 版。
''' </summary>
@@ -801,11 +817,28 @@
''' </summary>
Public ReadOnly Property UrlBase As String
Get
Dim PackageName As String = If(IsLegacy, "forge", "neoforge")
Dim PackageName As String = If(Inherit = "1.20.1", "forge", "neoforge")
Return $"https://maven.neoforged.net/releases/net/neoforged/{PackageName}/{ApiName}/{PackageName}-{ApiName}"
End Get
End Property
''' <summary>
''' 加载器名称。Forge 或 NeoForge。
''' </summary>
Public Overrides ReadOnly Property LoaderName As String
Get
Return "NeoForge"
End Get
End Property
''' <summary>
''' 文件扩展名。不以小数点开头。
''' </summary>
Public Overrides ReadOnly Property FileExtension As String
Get
Return "jar"
End Get
End Property
Public Sub New(ApiName As String)
IsNeoForge = True
Me.ApiName = ApiName
@@ -816,12 +849,18 @@
Inherit = "1.20.1"
ElseIf ApiName.StartsWith("0.") Then '0.25w14craftmine.3-beta
VersionName = ApiName
Version = New Version("0.0." & ApiName.BeforeFirst("-").AfterFirst(".").AfterFirst(".") & ".0") 'Minor 里有字母，但 Version 类的 Minor 是 Int 类型，只能这样写了
Inherit = ApiName.BeforeFirst("-").AfterFirst(".").BeforeFirst(".")
Else '20.4.30-beta
Dim Segments = ApiName.BeforeFirst("-").Split("."c)
Version = New Version(0, 0, Segments.Last)
Inherit = Segments(1)
Else '20.4.30-beta；26.1.0.0-alpha.1+snapshot-1
VersionName = ApiName
Version = New Version(ApiName.BeforeFirst("-"))
Inherit = $"1.{Version.Major}" & If(Version.Minor = 0, "", "." & Version.Minor)
If Version.Major >= 24 Then
Inherit = Version.ToString.Replace(".0", "")
Else
Inherit = "1." & Version.Major & If(Version.Minor > 0, "." & Version.Minor, "")
End If
If VersionName.Contains("+") Then Inherit &= "-" & VersionName.AfterFirst("+")
End If
End Sub
End Class
@@ -888,12 +927,12 @@
Private Function GetNeoForgeEntries(LatestJson As String, LatestLegacyJson As String) As List(Of DlNeoForgeListEntry)
Dim VersionNames = RegexSearch(LatestLegacyJson & LatestJson,
"(?<="")(?:(1\.20\.1-)?\d+\.\d+\.\d+|0\.[^.]+\.\d+)(-beta)?(?="")") '我寻思直接正则就行.jpg
"(?<="")(1\.20\.1-)?\d+\.[^\.]+\.\d+(\.\d+)?(-(beta|alpha)(\.\d+)?)?(\+snapshot-\d+)?(?="")")
Dim Versions = VersionNames.
Where(Function(name) name <> "47.1.82"). '这个版本虽然在版本列表中，但不能下载
Select(Function(name) New DlNeoForgeListEntry(name)).ToList
If Not Versions.Any() Then Throw New Exception("不可用")
Versions = Versions.OrderByDescending(Function(a) a.Version).ToList
Select(Function(name) New DlNeoForgeListEntry(name)).
OrderByDescending(Function(a) a).ToList
If Not Versions.Any() Then Throw New Exception("无")
Return Versions
End Function
@@ -1308,7 +1347,7 @@
For ii = 0 To LoaderList.Count - 1
LoaderList(ii).Key.Input = Nothing '重置输入，以免以同样的输入“重试加载”时直接失败
If LoaderList(ii).Key.Error IsNot Nothing Then
If ErrorInfo Is Nothing OrElse LoaderList(ii).Key.Error.Message.Contains("不可用") Then
If ErrorInfo Is Nothing OrElse LoaderList(ii).Key.Error.Message = "无" Then
ErrorInfo = LoaderList(ii).Key.Error
End If
End If
Plain Craft Launcher 2/Modules/Minecraft/ModJava.vb
+50 -59
View File
@@ -35,7 +35,7 @@
''' <summary>
''' Java 的大版本号。
''' </summary>
Public ReadOnly Property VersionCode As Integer
Public ReadOnly Property MajorVersion As Integer
Get
Return Version.Minor
End Get
@@ -71,7 +71,7 @@
Public Overrides Function ToString() As String
Dim VersionString = Version.ToString
If VersionString.StartsWithF("1.") Then VersionString = Mid(VersionString, 3)
Return If(IsJre, "JRE ", "JDK ") & VersionCode & " (" & VersionString & ")" & If(Is64Bit, "", "，32 位") & If(IsUserImport, "，手动导入", "") & "：" & PathFolder
Return If(IsJre, "JRE ", "JDK ") & MajorVersion & " (" & VersionString & ")" & If(Is64Bit, "", "，32 位") & If(IsUserImport, "，手动导入", "") & "：" & PathFolder
End Function
'构造
@@ -124,7 +124,7 @@
'#3649：在 64 位系统上禁用 32 位 Java
If Not Is64Bit AndAlso Not Is32BitSystem Then Throw New Exception("该 Java 为 32 位版本，请安装 64 位的 Java")
'#2249：JRE 17 似乎会导致 Forge 安装失败，干脆禁用更多版本的 JRE
If IsJre AndAlso VersionCode >= 16 Then Throw New Exception("由于高版本 JRE 对游戏的兼容性很差，因此不再允许使用。你可以使用对应版本的 JDK，而非 JRE！")
If IsJre AndAlso MajorVersion >= 16 Then Throw New Exception("由于高版本 JRE 对游戏的兼容性很差，因此不再允许使用。你可以使用对应版本的 JDK，而非 JRE！")
Catch ex As ApplicationException
Throw ex
Catch ex As ThreadInterruptedException
@@ -199,19 +199,19 @@
''' 必须在工作线程调用，且必须包括 SyncLock JavaLock。
''' </summary>
Public Function JavaSelect(CancelException As String, Optional MinVersion As Version = Nothing, Optional MaxVersion As Version = Nothing,
Optional RelatedVersion As McVersion = Nothing) As JavaEntry
Optional GameInstance As McInstance = Nothing) As JavaEntry
Try
Dim AllowedJavaList As New List(Of JavaEntry)
'添加特定的 Java
Dim JavaPreList As New Dictionary(Of String, Boolean)
If PathMcFolder.Split("\").Count > 3 AndAlso Not PathMcFolder.Contains("AppData\Roaming") Then
JavaSearchFolder(GetPathFromFullPath(PathMcFolder), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹（如果不是根目录或 %APPDATA% 的话）
If McFolderSelected.Split("\").Count > 3 AndAlso Not McFolderSelected.Contains("AppData\Roaming") Then
JavaSearchFolder(GetPathFromFullPath(McFolderSelected), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹（如果不是根目录或 %APPDATA% 的话）
End If
JavaSearchFolder(PathMcFolder, JavaPreList, False, True) 'Minecraft 文件夹
JavaSearchFolder(McFolderSelected, JavaPreList, False, True) 'Minecraft 文件夹
JavaPreList = JavaPreList.Where(Function(j) Not j.Key.Contains(".minecraft\runtime")).
ToDictionary(Function(j) j.Key, Function(j) j.Value) '排除官启自带 Java（#4286）
If RelatedVersion IsNot Nothing Then JavaSearchFolder(RelatedVersion.Path, JavaPreList, False, True) '所选版本文件夹
If GameInstance IsNot Nothing Then JavaSearchFolder(GameInstance.PathVersion, JavaPreList, False, True) '所选版本文件夹
Dim TargetJavaList As New List(Of JavaEntry)
For Each Entry In JavaPreList
TargetJavaList.Add(New JavaEntry(Entry.Key, Entry.Value))
@@ -232,8 +232,8 @@
'获取版本独立设置中指定的 Java
Dim VersionSelect As String = ""
If RelatedVersion IsNot Nothing Then
VersionSelect = Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion)
If GameInstance IsNot Nothing Then
VersionSelect = Setup.Get("VersionArgumentJavaSelect", Instance:=GameInstance)
If VersionSelect.StartsWithF("{") Then
Try
UserJava = JavaEntry.FromJson(GetJson(VersionSelect))
@@ -242,7 +242,7 @@
Throw
Catch ex As Exception
UserJava = Nothing
Setup.Reset("VersionArgumentJavaSelect", Version:=RelatedVersion)
Setup.Reset("VersionArgumentJavaSelect", Instance:=GameInstance)
Log(ex, "版本独立设置中指定的 Java 已无法使用，此设置已重置", LogLevel.Hint)
End Try
End If
@@ -330,8 +330,8 @@ RetryGet:
Dim Right As String = MaxVersion.Minor & If(ShowRevision, "." & MaxVersion.MajorRevision & "." & MaxVersion.MinorRevision, "")
Requirement = "需要 Java " & If(Left = Right, Left, Left & " ~ " & Right)
End If
Dim JavaCurrent As String = UserJava.VersionCode & If(ShowRevision, "." & UserJava.Version.MajorRevision & "." & UserJava.Version.MinorRevision, "")
If RelatedVersion IsNot Nothing AndAlso Setup.Get("VersionAdvanceJava", RelatedVersion) Then
Dim JavaCurrent As String = UserJava.MajorVersion & If(ShowRevision, "." & UserJava.Version.MajorRevision & "." & UserJava.Version.MinorRevision, "")
If GameInstance IsNot Nothing AndAlso Setup.Get("VersionAdvanceJava", GameInstance) Then
'直接跳过弹窗
Log("[Java] 设置中指定了使用 Java " & JavaCurrent & "，但当前版本" & Requirement & "，这可能会导致游戏崩溃！", LogLevel.Debug)
AllowedJavaList = New List(Of JavaEntry) From {UserJava}
@@ -372,7 +372,7 @@ ExitUserJavaCheck:
UserPass:
'对适合的 Java 进行排序
AllowedJavaList = AllowedJavaList.Sort(AddressOf JavaSorter)
AllowedJavaList = AllowedJavaList.SortByComparison(AddressOf JavaSorter)
Log($"[Java] 排序后的 Java 优先顺序：")
For Each Java In AllowedJavaList
Log($"[Java] - {Java}")
@@ -408,12 +408,12 @@ UserPass:
''' <summary>
''' 是否强制指定了 64 位 Java。如果没有强制指定，返回是否安装了 64 位 Java。
''' </summary>
Public Function JavaIs64Bit(Optional RelatedVersion As McVersion = Nothing) As Boolean
Public Function JavaIs64Bit(Optional GameInstance As McInstance = Nothing) As Boolean
Try
'检查强制指定
Dim UserSetup As String = Setup.Get("LaunchArgumentJavaSelect")
If RelatedVersion IsNot Nothing Then
Dim UserSetupVersion As String = Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion)
If GameInstance IsNot Nothing Then
Dim UserSetupVersion As String = Setup.Get("VersionArgumentJavaSelect", Instance:=GameInstance)
If UserSetupVersion <> "使用全局设置" Then UserSetup = UserSetupVersion
End If
If UserSetup <> "" Then
@@ -422,7 +422,7 @@ UserPass:
UserJava = JavaEntry.FromJson(GetJson(UserSetup))
Catch ex As Exception
Log(ex, "版本指定的 Java 信息已损坏，已重置版本设置中指定的 Java")
Setup.Set("VersionArgumentJavaSelect", "使用全局设置", Version:=RelatedVersion)
Setup.Set("VersionArgumentJavaSelect", "使用全局设置", Instance:=GameInstance)
GoTo NoUserJava
End Try
For Each Java In JavaList
@@ -446,14 +446,14 @@ NoUserJava:
''' </summary>
Public Function JavaSorter(Left As JavaEntry, Right As JavaEntry) As Boolean
Dim PathInfo As New DirectoryInfo(Path)
Dim PathMcInfo As New DirectoryInfo(PathMcFolder)
Dim PathMcInfo As New DirectoryInfo(McFolderSelected)
'1. 尽量在当前文件夹或当前 Minecraft 文件夹
Dim ProgramPathParent As String, MinecraftPathParent As String = ""
ProgramPathParent = If(PathInfo.Parent, PathInfo).FullName
If PathMcFolder <> "" Then MinecraftPathParent = If(PathMcInfo.Parent, PathMcInfo).FullName
If McFolderSelected <> "" Then MinecraftPathParent = If(PathMcInfo.Parent, PathMcInfo).FullName
If Left.PathFolder.StartsWithF(ProgramPathParent) AndAlso Not Right.PathFolder.StartsWithF(ProgramPathParent) Then Return True
If Not Left.PathFolder.StartsWithF(ProgramPathParent) AndAlso Right.PathFolder.StartsWithF(ProgramPathParent) Then Return False
If PathMcFolder <> "" Then
If McFolderSelected <> "" Then
If Left.PathFolder.StartsWithF(MinecraftPathParent) AndAlso Not Right.PathFolder.StartsWithF(MinecraftPathParent) Then Return True
If Not Left.PathFolder.StartsWithF(MinecraftPathParent) AndAlso Right.PathFolder.StartsWithF(MinecraftPathParent) Then Return False
End If
@@ -464,10 +464,10 @@ NoUserJava:
If Left.IsJre AndAlso Not Right.IsJre Then Return True
If Not Left.IsJre AndAlso Right.IsJre Then Return False
'4. Java 大版本
If Left.VersionCode <> Right.VersionCode Then
If Left.MajorVersion <> Right.MajorVersion Then
' Java 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23...
Dim Weight = {0, 1, 2, 3, 4, 5, 6, 14, 30, 10, 12, 15, 13, 9, 8, 7, 11, 31, 29, 16, 17, 28, 27, 26, 25, 24, 23, 22, 21, 20, 19, 18}
Return Weight.ElementAtOrDefault(Left.VersionCode) >= Weight.ElementAtOrDefault(Right.VersionCode)
Return Weight.ElementAtOrDefault(Left.MajorVersion) >= Weight.ElementAtOrDefault(Right.MajorVersion)
End If
'5. 最次级版本号更接近 51
Return Math.Abs(Left.Version.Revision - 51) <= Math.Abs(Right.Version.Revision - 51)
@@ -487,11 +487,11 @@ NoUserJava:
FrmSetupLaunch.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True})
End Sub)
End If
If FrmVersionSetup IsNot Nothing Then
If FrmInstanceSetup IsNot Nothing Then
RunInUiWait(
Sub()
FrmVersionSetup.ComboArgumentJava.Items.Clear()
FrmVersionSetup.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True})
FrmInstanceSetup.ComboArgumentJava.Items.Clear()
FrmInstanceSetup.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True})
End Sub)
End If
@@ -525,8 +525,8 @@ NoUserJava:
'查找启动器目录中的 Java
JavaSearchFolder(Path, JavaPreList, False, IsFullSearch:=True)
'查找所选 Minecraft 文件夹中的 Java
If Not String.IsNullOrWhiteSpace(PathMcFolder) AndAlso Path <> PathMcFolder Then
JavaSearchFolder(PathMcFolder, JavaPreList, False, IsFullSearch:=True)
If Not String.IsNullOrWhiteSpace(McFolderSelected) AndAlso Path <> McFolderSelected Then
JavaSearchFolder(McFolderSelected, JavaPreList, False, IsFullSearch:=True)
End If
'若不全为符号链接，则清除符号链接的地址
@@ -579,7 +579,7 @@ NoUserJava:
For Each Entry In JavaPreList.Distinct(Function(a, b) a.Key.ToLower = b.Key.ToLower) '#794
NewJavaList.Add(New JavaEntry(Entry.Key, Entry.Value))
Next
NewJavaList = JavaCheckList(NewJavaList).Sort(AddressOf JavaSorter)
NewJavaList = JavaCheckList(NewJavaList).SortByComparison(AddressOf JavaSorter)
'修改设置项
Dim AllList As New JArray
@@ -596,7 +596,7 @@ NoUserJava:
Log("[Java] Java 搜索完成，发现 " & JavaList.Count & " 个 Java")
If FrmSetupLaunch IsNot Nothing Then RunInUi(Sub() FrmSetupLaunch.RefreshJavaComboBox())
If FrmVersionSetup IsNot Nothing Then RunInUi(Sub() FrmVersionSetup.RefreshJavaComboBox())
If FrmInstanceSetup IsNot Nothing Then RunInUi(Sub() FrmInstanceSetup.RefreshJavaComboBox())
End Sub
''' <summary>
@@ -695,28 +695,12 @@ Wait:
#Region "下载"
''' <summary>
''' 提示 Java 缺失，并弹窗确认是否自动下载。返回玩家选择是否下载。
''' 获取下载 Java 的加载器。需要开启 IsForceRestart 以正常刷新 Java 列表。
''' </summary>
Public Function JavaDownloadConfirm(VersionDescription As String, Optional ForcedManualDownload As Boolean = False) As Boolean
If ForcedManualDownload Then
MyMsgBox($"PCL 未找到 {VersionDescription}。" & vbCrLf &
$"请自行搜索并安装 {VersionDescription}，安装后在 设置 → 启动选项 → 游戏 Java 中重新搜索或导入。",
"未找到 Java")
Return False
Else
Return MyMsgBox($"PCL 未找到 {VersionDescription}，是否需要 PCL 自动下载？" & vbCrLf &
$"如果你已经安装了 {VersionDescription}，可以在 设置 → 启动选项 → 游戏 Java 中手动导入。",
"自动下载 Java？", "自动下载", "取消") = 1
End If
End Function
''' <summary>
''' 获取下载 Java 8/14/17/21 的加载器。需要开启 IsForceRestart 以正常刷新 Java 列表。
''' </summary>
Public Function JavaFixLoaders(Version As Integer) As LoaderCombo(Of Integer)
Public Function GetJavaDownloadLoader() As LoaderCombo(Of String)
Dim JavaDownloadLoader As New LoaderDownload("下载 Java 文件", New List(Of NetFile)) With {.ProgressWeight = 10}
Dim Loader = New LoaderCombo(Of Integer)($"下载 Java {Version}", {
New LoaderTask(Of Integer, List(Of NetFile))("获取 Java 下载信息", AddressOf JavaFileList) With {.ProgressWeight = 2},
Dim Loader = New LoaderCombo(Of String)($"下载 Java", {
New LoaderTask(Of String, List(Of NetFile))("获取 Java 下载信息", AddressOf JavaFileList) With {.ProgressWeight = 2},
JavaDownloadLoader,
JavaSearchLoader
})
@@ -733,22 +717,29 @@ Wait:
Return Loader
End Function
Private LastJavaBaseDir As String = Nothing '用于在下载中断或失败时删除未完成下载的 Java 文件夹，防止残留只下了一半但 -version 能跑的 Java
Private Sub JavaFileList(Loader As LoaderTask(Of Integer, List(Of NetFile)))
Private Sub JavaFileList(Loader As LoaderTask(Of String, List(Of NetFile)))
Log("[Java] 开始获取 Java 下载信息")
Dim IndexFileStr As String = NetRequestByLoader(DlVersionListOrder(
{"https://piston-meta.mojang.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json"},
{"https://bmclapi2.bangbang93.com/v1/products/java-runtime/2ec0cc96c44e5a76b9c8b7c39df7210883d12871/all.json"}
), IsJson:=True)
'获取下载地址
Dim MainEntry As JObject = CType(GetJson(IndexFileStr), JObject)($"windows-x{If(Is32BitSystem, "86", "64")}")
Dim Entries = MainEntry.Children.Reverse. '选择最靠后的一项（最新）
SelectMany(Function(e As JProperty) CType(e.Value, JArray).Select(Function(v) New KeyValuePair(Of String, JObject)(e.Name, v)))
Dim TargetEntry = Entries.First(Function(t) t.Value("version")("name").ToString.StartsWithF(Loader.Input))
Dim Address As String = TargetEntry.Value("manifest")("url")
Log($"[Java] 准备下载 Java {TargetEntry.Value("version")("name")}（{TargetEntry.Key}）：{Address}")
'查找要下载的目标 Java
Dim TargetEntry As JProperty = Nothing
Dim Components As JObject = CType(GetJson(IndexFileStr), JObject)($"windows-x{If(Is32BitSystem, "86", "64")}")
If Components.ContainsKey(Loader.Input) Then '精确匹配
TargetEntry = Components.Property(Loader.Input)
Else '模糊匹配
TargetEntry = Components.Properties.FirstOrDefault(
Function(c) c.Value?.ToArray.FirstOrDefault()?("version")("name").ToString.StartsWithF(Loader.Input))
If TargetEntry Is Nothing Then Throw New Exception($"未能找到所需的 Java {Loader.Input}")
End If
Dim TargetComponent = TargetEntry.Value.ToArray.FirstOrDefault
If TargetComponent Is Nothing Then Throw New Exception($"Mojang 未提供所需的 Java {Loader.Input}")
'获取文件列表
Dim Address As String = TargetComponent("manifest")("url")
McLaunchLog($"准备下载 Java {TargetComponent("version")("name")}（{TargetEntry.Name}）：{Address}")
Dim ListFileStr As String = NetRequestByLoader(DlSourceOrder({Address}, {Address.Replace("piston-meta.mojang.com", "bmclapi2.bangbang93.com")}), IsJson:=True)
LastJavaBaseDir = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\runtime\" & TargetEntry.Key & "\"
LastJavaBaseDir = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\runtime\" & TargetEntry.Name & "\"
Dim Results As New List(Of NetFile)
For Each File As JProperty In CType(GetJson(ListFileStr), JObject)("files")
If CType(File.Value, JObject)("downloads")?("raw") Is Nothing Then Continue For
Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb
+207 -219
View File
@@ -18,9 +18,9 @@ Public Module ModLaunch
Public SaveBatch As String = Nothing
''' <summary>
''' 强行指定启动的 MC 版本。
''' 默认值：Nothing。使用 McVersionCurrent。
''' 默认值：Nothing。使用 McInstanceCurrent。
''' </summary>
Public Version As McVersion = Nothing
Public Instance As McInstance = Nothing
''' <summary>
''' 额外的启动参数。
''' </summary>
@@ -39,23 +39,30 @@ Public Module ModLaunch
Return False
End If
'强制切换需要启动的版本
If CurrentLaunchOptions.Version IsNot Nothing AndAlso McVersionCurrent <> CurrentLaunchOptions.Version Then
McLaunchLog("在启动前切换到版本 " & CurrentLaunchOptions.Version.Name)
If CurrentLaunchOptions.Instance IsNot Nothing AndAlso McInstanceSelected <> CurrentLaunchOptions.Instance Then
McLaunchLog("在启动前切换到版本 " & CurrentLaunchOptions.Instance.Name)
'检查版本是否存在
Try
CurrentLaunchOptions.Instance.GetJsonPath()
Catch
Hint($"无法启动 {CurrentLaunchOptions.Instance.Name}：当前 Minecraft 文件夹中尚未安装该版本！", HintType.Red)
Return False
End Try
'检查版本
CurrentLaunchOptions.Version.Load()
If CurrentLaunchOptions.Version.State = McVersionState.Error Then
Hint("无法启动 Minecraft：" & CurrentLaunchOptions.Version.Info, HintType.Red)
CurrentLaunchOptions.Instance.Load()
If CurrentLaunchOptions.Instance.State = McInstanceState.Error Then
Hint($"无法启动 {CurrentLaunchOptions.Instance.Name}：{CurrentLaunchOptions.Instance.Info}", HintType.Red)
Return False
End If
'切换版本
McVersionCurrent = CurrentLaunchOptions.Version
Setup.Set("LaunchVersionSelect", McVersionCurrent.Name)
McInstanceSelected = CurrentLaunchOptions.Instance
Setup.Set("LaunchVersionSelect", McInstanceSelected.Name)
FrmLaunchLeft.RefreshButtonsUI()
FrmLaunchLeft.RefreshPage(False, False)
End If
FrmMain.AprilGiveup()
'禁止进入版本选择页面（否则就可以在启动中切换 McVersionCurrent 了）
FrmMain.PageStack = FrmMain.PageStack.Where(Function(p) p.Page <> FormMain.PageType.VersionSelect).ToList
'禁止进入版本选择页面（否则就可以在启动中切换 McInstanceSelected 了）
FrmMain.PageStack = FrmMain.PageStack.Where(Function(p) p.Page <> FormMain.PageType.InstanceSelect).ToList
'实际启动加载器
McLaunchLoader.Start(Options, IsForceRestart:=True)
Return True
@@ -109,7 +116,7 @@ Public Module ModLaunch
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(McVersionCurrent, False, AssetsIndexExistsBehaviour.DownloadInBackground)) With {.ProgressWeight = 15, .Show = False},
New LoaderCombo(Of String)("补全文件", DlClientFix(McInstanceSelected, False, AssetsIndexExistsBehaviour.DownloadInBackground)) With {.ProgressWeight = 15, .Show = False},
New LoaderTask(Of String, List(Of McLibToken))("获取启动参数", AddressOf McLaunchArgumentMain) With {.ProgressWeight = 2},
New LoaderTask(Of List(Of McLibToken), Integer)("解压文件", AddressOf McLaunchNatives) With {.ProgressWeight = 2},
New LoaderTask(Of Integer, Integer)("预启动处理", AddressOf McLaunchPrerun) With {.ProgressWeight = 1},
@@ -119,7 +126,7 @@ Public Module ModLaunch
New LoaderTask(Of Integer, Integer)("结束处理", AddressOf McLaunchEnd) With {.ProgressWeight = 1}
}
'内存优化
Select Case Setup.Get("VersionRamOptimize", Version:=McVersionCurrent)
Select Case Setup.Get("VersionRamOptimize", Instance:=McInstanceSelected)
Case 0 '全局
If Setup.Get("LaunchArgumentRam") Then '使用全局设置
CType(Loaders(2), LoaderCombo(Of String)).Block = False
@@ -140,17 +147,17 @@ Public Module ModLaunch
LoaderTaskbarAdd(LaunchLoader)
Do While LaunchLoader.State = LoadState.Loading
FrmLaunchLeft.Dispatcher.Invoke(AddressOf FrmLaunchLeft.LaunchingRefresh)
Thread.Sleep(200)
Thread.Sleep(100)
Loop
FrmLaunchLeft.Dispatcher.Invoke(AddressOf FrmLaunchLeft.LaunchingRefresh)
'成功与失败处理
Select Case LaunchLoader.State
Case LoadState.Finished
Hint(McVersionCurrent.Name & " 启动成功！", HintType.Green)
Hint(McInstanceSelected.Name & " 启动成功！", HintType.Green)
'上报
If Not IsSavingBatch Then
Telemetry("Minecraft 启动成功",
"Version", McVersionCurrent.Version.ToString,
"Version", McInstanceSelected.VersionDisplayName,
"LoginType", GetStringFromEnum(CType(Setup.Get("LoginType"), McLoginType)))
End If
Case LoadState.Aborted
@@ -185,7 +192,7 @@ NextInner:
'上报
If Not IsSavingBatch Then
Telemetry("Minecraft 启动失败",
"Version", McVersionCurrent.Version.ToString,
"Version", McInstanceSelected.VersionDisplayName,
"LoginType", GetStringFromEnum(CType(Setup.Get("LoginType"), McLoginType)),
"Exception", FilterUserName(FilterAccessToken(ex.GetDetail(), "*"), "*"))
End If
@@ -223,12 +230,12 @@ NextInner:
Private Sub McLaunchPrecheck()
If Setup.Get("SystemDebugDelay") Then Thread.Sleep(RandomInteger(100, 2000))
'检查路径
If McVersionCurrent.PathIndie.Contains("!") OrElse McVersionCurrent.PathIndie.Contains(";") Then Throw New Exception("游戏路径中不可包含 ! 或 ;（" & McVersionCurrent.PathIndie & "）")
If McVersionCurrent.Path.Contains("!") OrElse McVersionCurrent.Path.Contains(";") Then Throw New Exception("游戏路径中不可包含 ! 或 ;（" & McVersionCurrent.Path & "）")
If McInstanceSelected.PathIndie.Contains("!") OrElse McInstanceSelected.PathIndie.Contains(";") Then Throw New Exception("游戏路径中不可包含 ! 或 ;（" & McInstanceSelected.PathIndie & "）")
If McInstanceSelected.PathVersion.Contains("!") OrElse McInstanceSelected.PathVersion.Contains(";") Then Throw New Exception("游戏路径中不可包含 ! 或 ;（" & McInstanceSelected.PathVersion & "）")
'检查版本
If McVersionCurrent Is Nothing Then Throw New Exception("未选择 Minecraft 版本！")
McVersionCurrent.Load()
If McVersionCurrent.State = McVersionState.Error Then Throw New Exception("Minecraft 存在问题：" & McVersionCurrent.Info)
If McInstanceSelected Is Nothing Then Throw New Exception("未选择 Minecraft 版本！")
McInstanceSelected.Load()
If McInstanceSelected.State = McInstanceState.Error Then Throw New Exception("Minecraft 存在问题：" & McInstanceSelected.Info)
'检查输入信息
Dim CheckResult As String = ""
RunInUiWait(Sub() CheckResult = McLoginAble(McLoginInput()))
@@ -817,7 +824,7 @@ LoginFinish:
Dim ErrorMessage As String = Nothing
Try
Dim Response = DirectCast(ex, ResponsedWebException).Response
If ErrorMessage.ContainsF("errorMessage", True) Then ErrorMessage = GetJson(Response)("errorMessage")
If Response.ContainsF("errorMessage", True) Then ErrorMessage = GetJson(Response)("errorMessage").ToString()
Catch
End Try
If Not String.IsNullOrWhiteSpace(ErrorMessage) Then
@@ -940,24 +947,20 @@ Retry:
}"
Dim Result As String = NetRequestByClientMultiple("https://user.auth.xboxlive.com/user/authenticate", HttpMethod.Post,
Content:=Request, ContentType:="application/json", RequireJson:=True)
Dim ResultJson As JObject = GetJson(Result)
Dim XBLToken As String = ResultJson("Token").ToString
Return XBLToken
Return GetJson(Result)("Token").ToString
End Function
'微软登录步骤 3：从 XBLToken 获取 {XSTSToken, UHS}
Private Function MsLoginStep3(XBLToken As String) As String()
McLaunchLog("开始微软登录步骤 3/6")
Dim Request As String = "{
""Properties"": {
""SandboxId"": ""RETAIL"",
""UserTokens"": [
""" & XBLToken & """
]
},
""RelyingParty"": ""rp://api.minecraftservices.com/"",
""TokenType"": ""JWT""
}"
""Properties"": {
""SandboxId"": ""RETAIL"",
""UserTokens"": [""" & XBLToken & """]
},
""RelyingParty"": ""rp://api.minecraftservices.com/"",
""TokenType"": ""JWT""
}"
Dim Result As String
Try
Result = NetRequestByClientMultiple("https://xsts.auth.xboxlive.com/xsts/authorize", HttpMethod.Post,
@@ -1098,7 +1101,7 @@ Retry:
'使用正版用户名
Try
If SkinName <> "" AndAlso
McVersionCurrent IsNot Nothing AndAlso McVersionCurrent.Version.McCodeMain < 20 Then '1.20+ 或快照版不能使用该项（#3746）
McInstanceSelected IsNot Nothing AndAlso McInstanceSelected.Version.Vanilla.Major < 20 Then '1.20+ 或快照版不能使用该项（#3746）
Log("[Skin] 由于离线皮肤设置，使用正版 UUID：" & SkinName)
Uuid = McLoginMojangUuid(SkinName, False)
End If
@@ -1151,85 +1154,94 @@ Retry:
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)
'MC 大版本检测
If (Not McVersionCurrent.Version.IsStandardVersion AndAlso McVersionCurrent.ReleaseTime >= New Date(2024, 4, 2)) OrElse
(McVersionCurrent.Version.IsStandardVersion AndAlso McVersionCurrent.Version.McVersion >= New Version(1, 20, 5)) Then
'原版 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 McVersionCurrent.Version.IsStandardVersion AndAlso McVersionCurrent.ReleaseTime >= New Date(2021, 11, 16)) OrElse
(McVersionCurrent.Version.IsStandardVersion AndAlso McVersionCurrent.Version.McVersion >= New Version(1, 18)) Then
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 McVersionCurrent.Version.IsStandardVersion AndAlso McVersionCurrent.ReleaseTime >= New Date(2021, 5, 11)) OrElse
(McVersionCurrent.Version.IsStandardVersion AndAlso McVersionCurrent.Version.McVersion >= New Version(1, 17)) Then
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 McVersionCurrent.ReleaseTime.Year >= 2017 Then 'Minecraft 1.12 与 1.11 的分界线正好是 2017 年，太棒了
ElseIf McInstanceSelected.ReleaseTime.Year >= 2017 Then 'Minecraft 1.12 与 1.11 的分界线正好是 2017 年，太棒了
'1.12+：至少 Java 8
MinVer = New Version(1, 8, 0, 0)
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)
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)
End If
If McVersionCurrent.JsonVersion?("java_version") IsNot Nothing Then
Dim RecommendedJava As Integer = McVersionCurrent.JsonVersion("java_version").ToObject(Of Integer)
McLaunchLog("Mojang 推荐使用 Java " & RecommendedJava)
If RecommendedJava >= 22 Then MinVer = New Version(1, RecommendedJava, 0, 0) '潜在的向后兼容
'原版 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 McVersionCurrent.Version.HasOptiFine AndAlso McVersionCurrent.Version.IsStandardVersion Then '不管非标准版本
If McVersionCurrent.Version.McVersion < New Version(1, 7) Then
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 McVersionCurrent.Version.McVersion >= New Version(1, 8) AndAlso McVersionCurrent.Version.McVersion < New Version(1, 12) Then
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 McVersionCurrent.Version.McCodeMain = 12 Then
ElseIf McInstanceSelected.Version.Vanilla.Major = 12 Then
'1.12：最高 Java 8
MaxVer = New Version(1, 8, 999, 999)
End If
End If
'Forge 检测
If McVersionCurrent.Version.HasForge Then
If McVersionCurrent.Version.McVersion >= New Version(1, 6, 1) AndAlso McVersionCurrent.Version.McVersion <= New Version(1, 7, 2) Then
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 McVersionCurrent.Version.McCodeMain <= 12 OrElse Not McVersionCurrent.Version.IsStandardVersion Then '非标准版本
ElseIf McInstanceSelected.Version.Vanilla.Major <= 12 OrElse Not McInstanceSelected.Version.Vaild Then '非标准版本
'<=1.12：Java 8
MaxVer = New Version(1, 8, 999, 999)
ElseIf McVersionCurrent.Version.McCodeMain <= 14 Then
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 McVersionCurrent.Version.McCodeMain = 15 Then
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 VersionSortBoolean(McVersionCurrent.Version.ForgeVersion, "34.0.0") AndAlso VersionSortBoolean("36.2.25", McVersionCurrent.Version.ForgeVersion) Then
ElseIf CompareVersionGE(McInstanceSelected.Version.Forge, "34.0.0") AndAlso CompareVersionGE("36.2.25", McInstanceSelected.Version.Forge) Then
'1.16，Forge 34.X ~ 36.2.25：最高 Java 8u320
MaxVer = If(New Version(1, 8, 0, 320) < MaxVer, New Version(1, 8, 0, 320), MaxVer)
ElseIf McVersionCurrent.Version.McCodeMain >= 18 AndAlso McVersionCurrent.Version.McCodeMain < 19 AndAlso McVersionCurrent.Version.HasOptiFine Then '#305
ElseIf McInstanceSelected.Version.Vanilla.Major >= 18 AndAlso McInstanceSelected.Version.Vanilla.Major < 19 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)
End If
End If
'Fabric 检测
If McVersionCurrent.Version.HasFabric AndAlso McVersionCurrent.Version.IsStandardVersion Then '不管非标准版本
If McVersionCurrent.Version.McCodeMain >= 15 AndAlso McVersionCurrent.Version.McCodeMain <= 16 Then
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 McVersionCurrent.Version.McCodeMain >= 18 Then
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 McVersionCurrent.Version.HasLiteLoader AndAlso McVersionCurrent.Version.IsStandardVersion Then '不管非标准版本
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
@@ -1244,7 +1256,7 @@ Retry:
'选择 Java
McLaunchLog("Java 版本需求：最低 " & MinVer.ToString & "，最高 " & MaxVer.ToString)
McLaunchJavaSelected = JavaSelect("$$", MinVer, MaxVer, McVersionCurrent)
McLaunchJavaSelected = JavaSelect("$$", MinVer, MaxVer, McInstanceSelected)
If Task.IsAborted Then Return
If McLaunchJavaSelected IsNot Nothing Then
McLaunchLog("选择的 Java：" & McLaunchJavaSelected.ToString)
@@ -1255,40 +1267,25 @@ Retry:
If Task.IsAborted Then Return '中断加载会导致 JavaSelect 异常地返回空值，误判找不到 Java
McLaunchLog("无合适的 Java，需要确认是否自动下载")
Dim JavaCode As String
If MinVer >= New Version(1, 22) Then '潜在的向后兼容
If MinVer >= New Version(1, 9) Then
JavaCode = MinVer.Minor
If Not JavaDownloadConfirm("Java " & JavaCode) Then Throw New Exception("$$")
ElseIf MinVer >= New Version(1, 21) Then
JavaCode = 21
If Not JavaDownloadConfirm("Java 21") Then Throw New Exception("$$")
ElseIf MinVer >= New Version(1, 9) Then
JavaCode = 17
If Not JavaDownloadConfirm("Java 17") Then Throw New Exception("$$")
ElseIf MaxVer < New Version(1, 8) Then
JavaCode = 7
If McVersionCurrent.Version.HasForge Then
MyMsgBox("你需要先安装 LegacyJavaFixer Mod，或自行安装 Java 7，然后才能启动该版本。", "未找到 Java")
Else
If Not JavaDownloadConfirm("Java 7", True) Then Throw New Exception("$$")
End If
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
JavaCode = "8u141"
If Not JavaDownloadConfirm("Java 8.0.141 ~ 8.0.320", True) Then Throw New Exception("$$")
MyMsgBox($"你需要安装 Java 8u141 ~ 8u320 才能启动该版本。{vbCrLf}请自行搜索并安装，安装后在 设置 → 启动选项 → 游戏 Java 中重新搜索或导入。", "未找到 Java")
Throw New Exception("$$")
ElseIf MinVer > New Version(1, 8, 0, 140) Then
JavaCode = "8u141"
If Not JavaDownloadConfirm("Java 8.0.141 或更高版本的 Java 8", True) Then Throw New Exception("$$")
ElseIf MaxVer < New Version(1, 8, 0, 321) Then
JavaCode = 8
If Not JavaDownloadConfirm("Java 8.0.320 或更低版本的 Java 8") Then Throw New Exception("$$")
MyMsgBox($"你需要安装 Java 8u141 或更高版本的 Java 8 才能启动该版本。{vbCrLf}请自行搜索并安装，安装后在 设置 → 启动选项 → 游戏 Java 中重新搜索或导入。", "未找到 Java")
Throw New Exception("$$")
Else
JavaCode = 8
If Not JavaDownloadConfirm("Java 8") Then Throw New Exception("$$")
End If
'开始自动下载
Dim JavaLoader = JavaFixLoaders(JavaCode)
Dim JavaLoader = GetJavaDownloadLoader()
Try
JavaLoader.Start(JavaCode, IsForceRestart:=True)
JavaLoader.Start(If(RecommendedComponent, JavaCode), IsForceRestart:=True) '在 Java 22+ 时优先使用 Mojang 提供的 Component 字段
Do While JavaLoader.State = LoadState.Loading AndAlso Not Task.IsAborted
Task.Progress = JavaLoader.Progress
Thread.Sleep(10)
@@ -1299,7 +1296,7 @@ Retry:
'检查下载结果
If JavaSearchLoader.State <> LoadState.Loading Then JavaSearchLoader.State = LoadState.Waiting '2872#
McLaunchJavaSelected = JavaSelect("$$", MinVer, MaxVer, McVersionCurrent)
McLaunchJavaSelected = JavaSelect("$$", MinVer, MaxVer, McInstanceSelected)
If Task.IsAborted Then Return
If McLaunchJavaSelected IsNot Nothing Then
McLaunchLog("选择的 Java：" & McLaunchJavaSelected.ToString)
@@ -1356,32 +1353,32 @@ Retry:
McLaunchLog("开始获取 Minecraft 启动参数")
'获取基准字符串与参数信息
Dim Arguments As String
If McVersionCurrent.JsonObject("arguments") IsNot Nothing AndAlso McVersionCurrent.JsonObject("arguments")("jvm") IsNot Nothing Then
If McInstanceSelected.JsonObject("arguments") IsNot Nothing AndAlso McInstanceSelected.JsonObject("arguments")("jvm") IsNot Nothing Then
McLaunchLog("获取新版 JVM 参数")
Arguments = McLaunchArgumentsJvmNew(McVersionCurrent)
Arguments = McLaunchArgumentsJvmNew(McInstanceSelected)
McLaunchLog("新版 JVM 参数获取成功：")
McLaunchLog(Arguments)
Else
McLaunchLog("获取旧版 JVM 参数")
Arguments = McLaunchArgumentsJvmOld(McVersionCurrent)
Arguments = McLaunchArgumentsJvmOld(McInstanceSelected)
McLaunchLog("旧版 JVM 参数获取成功：")
McLaunchLog(Arguments)
End If
If Not String.IsNullOrEmpty(McVersionCurrent.JsonObject("minecraftArguments")) Then '有的版本是空字符串
If Not String.IsNullOrEmpty(McInstanceSelected.JsonObject("minecraftArguments")) Then '有的版本是空字符串
McLaunchLog("获取旧版 Game 参数")
Arguments += " " & McLaunchArgumentsGameOld(McVersionCurrent)
Arguments += " " & McLaunchArgumentsGameOld(McInstanceSelected)
McLaunchLog("旧版 Game 参数获取成功")
End If
If McVersionCurrent.JsonObject("arguments") IsNot Nothing AndAlso McVersionCurrent.JsonObject("arguments")("game") IsNot Nothing Then
If McInstanceSelected.JsonObject("arguments") IsNot Nothing AndAlso McInstanceSelected.JsonObject("arguments")("game") IsNot Nothing Then
McLaunchLog("获取新版 Game 参数")
Arguments += " " & McLaunchArgumentsGameNew(McVersionCurrent)
Arguments += " " & McLaunchArgumentsGameNew(McInstanceSelected)
McLaunchLog("新版 Game 参数获取成功")
End If
'编码参数（#4700、#5892、#5909）
If McLaunchJavaSelected.VersionCode >= 18 Then 'Dfile.encoding 需要放在 Dstdout.encoding 后面（#6934）
If McLaunchJavaSelected.MajorVersion >= 18 Then 'Dfile.encoding 需要放在 Dstdout.encoding 后面（#6934）
If Not Arguments.Contains("-Dfile.encoding=") Then Arguments = "-Dfile.encoding=COMPAT " & Arguments
End If
If McLaunchJavaSelected.VersionCode > 8 Then
If McLaunchJavaSelected.MajorVersion > 8 Then
If Not Arguments.Contains("-Dstdout.encoding=") Then Arguments = "-Dstdout.encoding=UTF-8 " & Arguments
If Not Arguments.Contains("-Dstderr.encoding=") Then Arguments = "-Dstderr.encoding=UTF-8 " & Arguments
End If
@@ -1394,10 +1391,10 @@ Retry:
Arguments += " " & Arg.Trim
Next
'自定义
Dim ArgumentGame As String = Setup.Get("VersionAdvanceGame", Version:=McVersionCurrent)
Dim ArgumentGame As String = Setup.Get("VersionAdvanceGame", Instance:=McInstanceSelected)
Arguments += " " & ArgumentReplace(If(ArgumentGame = "", Setup.Get("LaunchAdvanceGame"), ArgumentGame))
'进行参数替换
Dim ReplaceArguments = McLaunchArgumentsReplace(McVersionCurrent, Loader)
Dim ReplaceArguments = McLaunchArgumentsReplace(McInstanceSelected, Loader)
If String.IsNullOrWhiteSpace(ReplaceArguments("${version_type}")) Then
'若自定义信息为空，则去掉该部分
Arguments = Arguments.Replace(" --versionType ${version_type}", "")
@@ -1414,11 +1411,11 @@ Retry:
FinalArguments = FinalArguments.TrimEnd
'替换 Module Path 为短路径（Forge 会在版本 JSON 硬编码这些路径）
FinalArguments = FinalArguments.RegexReplaceEach("(?<= (-p|--module-path) "")[^""]+(?="" )",
Function(ModulePath) ModulePath.Value.RegexReplaceEach("[A-Z]{1}:\\[^;]+", Function(m) ShortenPath(m.Value)))
Function(ModulePath) ModulePath.Value.RegexReplaceEach("[A-Z]:\\[^;]+", Function(m) ShortenPath(m.Value)))
'进服
Dim Server As String = If(String.IsNullOrEmpty(CurrentLaunchOptions.ServerIp), Setup.Get("VersionServerEnter", McVersionCurrent), CurrentLaunchOptions.ServerIp)
Dim Server As String = If(String.IsNullOrEmpty(CurrentLaunchOptions.ServerIp), Setup.Get("VersionServerEnter", McInstanceSelected), CurrentLaunchOptions.ServerIp)
If Server.Length > 0 Then
If McVersionCurrent.ReleaseTime > New Date(2023, 4, 4) Then
If McInstanceSelected.ReleaseTime > New Date(2023, 4, 4) Then
'QuickPlay
FinalArguments += $" --quickPlayMultiplayer ""{Server}"""
Else
@@ -1430,7 +1427,7 @@ Retry:
'不包含端口号
FinalArguments += $" --server {Server} --port 25565"
End If
If McVersionCurrent.Version.HasOptiFine Then Hint("OptiFine 与自动进入服务器可能不兼容，有概率导致材质丢失甚至游戏崩溃！", HintType.Red)
If McInstanceSelected.Version.HasOptiFine Then Hint("OptiFine 与自动进入服务器可能不兼容，有概率导致材质丢失甚至游戏崩溃！", HintType.Red)
End If
End If
'输出
@@ -1440,30 +1437,30 @@ Retry:
End Sub
'Jvm 部分（第一段）
Private Function McLaunchArgumentsJvmOld(Version As McVersion) As String
Private Function McLaunchArgumentsJvmOld(Instance As McInstance) As String
'存储以空格为间隔的启动参数列表
Dim DataList As New List(Of String)
'输出固定参数
DataList.Add("-XX:HeapDumpPath=MojangTricksIntelDriversForPerformance_javaw.exe_minecraft.exe.heapdump")
Dim ArgumentJvm As String = Setup.Get("VersionAdvanceJvm", Version:=McVersionCurrent)
Dim ArgumentJvm As String = Setup.Get("VersionAdvanceJvm", Instance:=McInstanceSelected)
If ArgumentJvm = "" Then ArgumentJvm = Setup.Get("LaunchAdvanceJvm")
If Not ArgumentJvm.Contains("-Dlog4j2.formatMsgNoLookups=true") Then ArgumentJvm += " -Dlog4j2.formatMsgNoLookups=true"
ArgumentJvm = ArgumentJvm.Replace(" -XX:MaxDirectMemorySize=256M", "") '#3511 的清理
DataList.Insert(0, ArgumentReplace(ArgumentJvm)) '可变 JVM 参数
DataList.Add("-Xmn" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) * 1024 * 0.15) & "m")
DataList.Add("-Xmx" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) * 1024) & "m")
DataList.Add("-Xmn" & Math.Floor(PageInstanceSetup.GetRam(McInstanceSelected, Not McLaunchJavaSelected.Is64Bit) * 1024 * 0.15) & "m")
DataList.Add("-Xmx" & Math.Floor(PageInstanceSetup.GetRam(McInstanceSelected, Not McLaunchJavaSelected.Is64Bit) * 1024) & "m")
DataList.Add("""-Djava.library.path=" & GetNativesFolder() & """")
DataList.Add("-cp ${classpath}") '把支持库添加进启动参数表
'统一通行证
If McLoginLoader.Output.Type = "Nide" Then
DataList.Insert(0, "-Dnide8auth.client=true -javaagent:""" & PathAppdata & "nide8auth.jar""=" & Setup.Get("VersionServerNide", Version:=McVersionCurrent))
DataList.Insert(0, "-Dnide8auth.client=true -javaagent:""" & PathAppdata & "nide8auth.jar""=" & Setup.Get("VersionServerNide", Instance:=McInstanceSelected))
End If
'Authlib-Injector
If McLoginLoader.Output.Type = "Auth" Then
If McLaunchJavaSelected.VersionCode >= 6 Then DataList.Add("-Djavax.net.ssl.trustStoreType=WINDOWS-ROOT") '信任系统根证书（5252#）
Dim Server As String = Setup.Get("VersionServerAuthServer", McVersionCurrent)
If McLaunchJavaSelected.MajorVersion >= 6 Then DataList.Add("-Djavax.net.ssl.trustStoreType=WINDOWS-ROOT") '信任系统根证书（5252#）
Dim Server As String = Setup.Get("VersionServerAuthServer", McInstanceSelected)
Try
Dim Response As String = NetRequestByClientRetry(Server, Encoding:=Encoding.UTF8)
DataList.Insert(0, "-javaagent:""" & PathPure & "authlib-injector.jar""=" & Server &
@@ -1475,17 +1472,17 @@ Retry:
End If
'添加 Java Wrapper 作为主 Jar
If Not Setup.Get("LaunchAdvanceDisableJLW") AndAlso Not Setup.Get("VersionAdvanceDisableJLW", McVersionCurrent) Then
If McLaunchJavaSelected.VersionCode >= 9 Then DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
If Not Setup.Get("LaunchAdvanceDisableJLW") AndAlso Not Setup.Get("VersionAdvanceDisableJLW", McInstanceSelected) Then
If McLaunchJavaSelected.MajorVersion >= 9 Then DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
DataList.Add("-Doolloo.jlw.tmpdir=""" & PathPure.TrimEnd("\") & """")
DataList.Add("-jar """ & ExtractJavaWrapper() & """")
End If
'添加 MainClass
If Version.JsonObject("mainClass") Is Nothing Then
If Instance.JsonObject("mainClass") Is Nothing Then
Throw New Exception("版本 json 中没有 mainClass 项！")
Else
DataList.Add(Version.JsonObject("mainClass"))
DataList.Add(Instance.JsonObject("mainClass"))
End If
'处理 DataList 的换行符
@@ -1493,14 +1490,14 @@ Retry:
Return Join(DataList, " ")
End Function
Private Function McLaunchArgumentsJvmNew(Version As McVersion) As String
Private Function McLaunchArgumentsJvmNew(Instance As McInstance) As String
Dim DataList As New List(Of String)
'获取 Json 中的 DataList
Dim CurrentVersion As McVersion = Version
NextVersion:
If CurrentVersion.JsonObject("arguments") IsNot Nothing AndAlso CurrentVersion.JsonObject("arguments")("jvm") IsNot Nothing Then
For Each SubJson As JToken In CurrentVersion.JsonObject("arguments")("jvm")
Dim CurrentInstance As McInstance = Instance
NextInstance:
If CurrentInstance.JsonObject("arguments") IsNot Nothing AndAlso CurrentInstance.JsonObject("arguments")("jvm") IsNot Nothing Then
For Each SubJson As JToken In CurrentInstance.JsonObject("arguments")("jvm")
If SubJson.Type = JTokenType.String Then
'字符串类型
DataList.Add(SubJson.ToString)
@@ -1519,9 +1516,9 @@ NextVersion:
End If
Next
End If
If CurrentVersion.InheritVersion <> "" Then
CurrentVersion = New McVersion(CurrentVersion.InheritVersion)
GoTo NextVersion
If CurrentInstance.InheritName <> "" Then
CurrentInstance = New McInstance(CurrentInstance.InheritName)
GoTo NextInstance
End If
'内存、Log4j 防御参数等
@@ -1529,12 +1526,12 @@ NextVersion:
'统一通行证
If McLoginLoader.Output.Type = "Nide" Then
DataList.Insert(0, "-javaagent:""" & PathAppdata & "nide8auth.jar""=" & Setup.Get("VersionServerNide", Version:=McVersionCurrent))
DataList.Insert(0, "-javaagent:""" & PathAppdata & "nide8auth.jar""=" & Setup.Get("VersionServerNide", Instance:=McInstanceSelected))
End If
'Authlib-Injector
If McLoginLoader.Output.Type = "Auth" Then
If McLaunchJavaSelected.VersionCode >= 6 Then DataList.Add("-Djavax.net.ssl.trustStoreType=WINDOWS-ROOT") '信任系统根证书（5252#）
Dim Server As String = Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent)
If McLaunchJavaSelected.MajorVersion >= 6 Then DataList.Add("-Djavax.net.ssl.trustStoreType=WINDOWS-ROOT") '信任系统根证书（5252#）
Dim Server As String = Setup.Get("VersionServerAuthServer", Instance:=McInstanceSelected)
Try
Dim Response As String = NetRequestByClientRetry(Server, Encoding:=Encoding.UTF8)
DataList.Insert(0, "-javaagent:""" & PathPure & "authlib-injector.jar""=" & Server &
@@ -1546,8 +1543,8 @@ NextVersion:
End If
'添加 Java Wrapper 作为主 Jar
If Not Setup.Get("LaunchAdvanceDisableJLW") AndAlso Not Setup.Get("VersionAdvanceDisableJLW", McVersionCurrent) Then
If McLaunchJavaSelected.VersionCode >= 9 Then DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
If Not Setup.Get("LaunchAdvanceDisableJLW") AndAlso Not Setup.Get("VersionAdvanceDisableJLW", McInstanceSelected) Then
If McLaunchJavaSelected.MajorVersion >= 9 Then DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
DataList.Add("-Doolloo.jlw.tmpdir=""" & PathPure.TrimEnd("\") & """")
DataList.Add("-jar """ & ExtractJavaWrapper() & """")
End If
@@ -1575,28 +1572,28 @@ NextVersion:
Dim Result As String = DeDuplicateDataList.Distinct.Join(" ")
'添加 MainClass
If Version.JsonObject("mainClass") Is Nothing Then
If Instance.JsonObject("mainClass") Is Nothing Then
Throw New Exception("版本 json 中没有 mainClass 项！")
Else
Result += " " & Version.JsonObject("mainClass").ToString
Result += " " & Instance.JsonObject("mainClass").ToString
End If
Return Result
End Function
'Game 部分（第二段）
Private Function McLaunchArgumentsGameOld(Version As McVersion) As String
Private Function McLaunchArgumentsGameOld(Instance As McInstance) As String
Dim DataList As New List(Of String)
'本地化 Minecraft 启动信息
Dim BasicString As String = Version.JsonObject("minecraftArguments").ToString
Dim BasicString As String = Instance.JsonObject("minecraftArguments").ToString
If Not BasicString.Contains("--height") Then BasicString += " --height ${resolution_height} --width ${resolution_width}"
DataList.Add(BasicString)
Dim Result As String = DataList.Join(" ")
'特别改变 OptiFineTweaker
If (Version.Version.HasForge OrElse Version.Version.HasLiteLoader) AndAlso Version.Version.HasOptiFine Then
If (Instance.Version.HasForge OrElse Instance.Version.HasLiteLoader) AndAlso Instance.Version.HasOptiFine Then
'把 OptiFineForgeTweaker 放在最后，不然会导致崩溃！
If Result.Contains("--tweakClass optifine.OptiFineForgeTweaker") Then
Log("[Launch] 发现正确的 OptiFineForge TweakClass，目前参数：" & Result)
@@ -1606,7 +1603,7 @@ NextVersion:
Log("[Launch] 发现错误的 OptiFineForge TweakClass，目前参数：" & Result)
Result = Result.Replace(" --tweakClass optifine.OptiFineTweaker", "").Replace("--tweakClass optifine.OptiFineTweaker ", "") & " --tweakClass optifine.OptiFineForgeTweaker"
Try
WriteFile(Version.Path & Version.Name & ".json", ReadFile(Version.Path & Version.Name & ".json").Replace("optifine.OptiFineTweaker", "optifine.OptiFineForgeTweaker"))
WriteFile(Instance.PathVersion & Instance.Name & ".json", ReadFile(Instance.PathVersion & Instance.Name & ".json").Replace("optifine.OptiFineTweaker", "optifine.OptiFineForgeTweaker"))
Catch ex As Exception
Log(ex, "替换 OptiFineForge TweakClass 失败")
End Try
@@ -1615,14 +1612,14 @@ NextVersion:
Return Result
End Function
Private Function McLaunchArgumentsGameNew(Version As McVersion) As String
Private Function McLaunchArgumentsGameNew(Instance As McInstance) As String
Dim DataList As New List(Of String)
'获取 Json 中的 DataList
Dim CurrentVersion As McVersion = Version
NextVersion:
If CurrentVersion.JsonObject("arguments") IsNot Nothing AndAlso CurrentVersion.JsonObject("arguments")("game") IsNot Nothing Then
For Each SubJson As JToken In CurrentVersion.JsonObject("arguments")("game")
Dim CurrentInstance As McInstance = Instance
NextInstance:
If CurrentInstance.JsonObject("arguments") IsNot Nothing AndAlso CurrentInstance.JsonObject("arguments")("game") IsNot Nothing Then
For Each SubJson As JToken In CurrentInstance.JsonObject("arguments")("game")
If SubJson.Type = JTokenType.String Then
'字符串类型
DataList.Add(SubJson.ToString)
@@ -1641,9 +1638,9 @@ NextVersion:
End If
Next
End If
If CurrentVersion.InheritVersion <> "" Then
CurrentVersion = New McVersion(CurrentVersion.InheritVersion)
GoTo NextVersion
If CurrentInstance.InheritName <> "" Then
CurrentInstance = New McInstance(CurrentInstance.InheritName)
GoTo NextInstance
End If
'将 "-XXX" 与后面 "XXX" 合并到一起
@@ -1667,7 +1664,7 @@ NextVersion:
McLaunchArgumentsGameNew = Join(DeDuplicateDataList.Distinct.ToList, " ")
'特别改变 OptiFineTweaker
If (Version.Version.HasForge OrElse Version.Version.HasLiteLoader) AndAlso Version.Version.HasOptiFine Then
If (Instance.Version.HasForge OrElse Instance.Version.HasLiteLoader) AndAlso Instance.Version.HasOptiFine Then
'把 OptiFineForgeTweaker 放在最后，不然会导致崩溃！
If McLaunchArgumentsGameNew.Contains("--tweakClass optifine.OptiFineForgeTweaker") Then
Log("[Launch] 发现正确的 OptiFineForge TweakClass，目前参数：" & McLaunchArgumentsGameNew)
@@ -1677,7 +1674,7 @@ NextVersion:
Log("[Launch] 发现错误的 OptiFineForge TweakClass，目前参数：" & McLaunchArgumentsGameNew)
McLaunchArgumentsGameNew = McLaunchArgumentsGameNew.Replace(" --tweakClass optifine.OptiFineTweaker", "").Replace("--tweakClass optifine.OptiFineTweaker ", "") & " --tweakClass optifine.OptiFineForgeTweaker"
Try
WriteFile(Version.Path & Version.Name & ".json", ReadFile(Version.Path & Version.Name & ".json").Replace("optifine.OptiFineTweaker", "optifine.OptiFineForgeTweaker"))
WriteFile(Instance.PathVersion & Instance.Name & ".json", ReadFile(Instance.PathVersion & Instance.Name & ".json").Replace("optifine.OptiFineTweaker", "optifine.OptiFineForgeTweaker"))
Catch ex As Exception
Log(ex, "替换 OptiFineForge TweakClass 失败")
End Try
@@ -1686,21 +1683,21 @@ NextVersion:
End Function
'替换 Arguments
Private Function McLaunchArgumentsReplace(Version As McVersion, ByRef Loader As LoaderTask(Of String, List(Of McLibToken))) As Dictionary(Of String, String)
Private Function McLaunchArgumentsReplace(Instance As McInstance, ByRef Loader As LoaderTask(Of String, List(Of McLibToken))) As Dictionary(Of String, String)
Dim GameArguments As New Dictionary(Of String, String)
'基础参数
GameArguments.Add("${classpath_separator}", ";")
GameArguments.Add("${natives_directory}", ShortenPath(GetNativesFolder()))
GameArguments.Add("${library_directory}", ShortenPath(PathMcFolder & "libraries"))
GameArguments.Add("${libraries_directory}", ShortenPath(PathMcFolder & "libraries"))
GameArguments.Add("${library_directory}", ShortenPath(McFolderSelected & "libraries"))
GameArguments.Add("${libraries_directory}", ShortenPath(McFolderSelected & "libraries"))
GameArguments.Add("${launcher_name}", "PCL")
GameArguments.Add("${launcher_version}", VersionCode)
GameArguments.Add("${version_name}", Version.Name)
Dim ArgumentInfo As String = Setup.Get("VersionArgumentInfo", Version:=McVersionCurrent)
GameArguments.Add("${version_name}", Instance.Name)
Dim ArgumentInfo As String = Setup.Get("VersionArgumentInfo", Instance:=McInstanceSelected)
GameArguments.Add("${version_type}", ArgumentReplace(If(ArgumentInfo = "", Setup.Get("LaunchArgumentInfo"), ArgumentInfo)))
GameArguments.Add("${game_directory}", ShortenPath(Left(McVersionCurrent.PathIndie, McVersionCurrent.PathIndie.Count - 1)))
GameArguments.Add("${assets_root}", ShortenPath(PathMcFolder & "assets"))
GameArguments.Add("${game_directory}", ShortenPath(Left(McInstanceSelected.PathIndie, McInstanceSelected.PathIndie.Count - 1)))
GameArguments.Add("${assets_root}", ShortenPath(McFolderSelected & "assets"))
GameArguments.Add("${user_properties}", "{}")
GameArguments.Add("${auth_player_name}", McLoginLoader.Output.Name)
GameArguments.Add("${auth_uuid}", McLoginLoader.Output.Uuid)
@@ -1708,7 +1705,7 @@ NextVersion:
GameArguments.Add("${access_token}", McLoginLoader.Output.AccessToken)
GameArguments.Add("${auth_session}", McLoginLoader.Output.AccessToken)
GameArguments.Add("${user_type}", "msa") '#1221
GameArguments.Add("${primary_jar}", ShortenPath(Version.Path & Version.Name & ".jar")) '#6942
GameArguments.Add("${primary_jar}", ShortenPath(Instance.PathVersion & Instance.Name & ".jar")) '#6942
'窗口尺寸参数
Dim GameSize As Size
@@ -1723,10 +1720,10 @@ NextVersion:
Case Else
GameSize = New Size(854, 480)
End Select
If McVersionCurrent.Version.McCodeMain <= 12 AndAlso
McLaunchJavaSelected.VersionCode <= 8 AndAlso McLaunchJavaSelected.Version.Revision >= 200 AndAlso McLaunchJavaSelected.Version.Revision <= 321 AndAlso
Not McVersionCurrent.Version.HasOptiFine AndAlso Not McVersionCurrent.Version.HasForge Then
'修复 #3463：1.12.2-，JRE 8u200~321 下窗口大小为设置大小的 DPI% 倍
'修复 1.12.2- 下 JRE 8u200~321 下窗口大小为设置大小的 DPI% 倍（#3463）
If McInstanceSelected.Version.Vanilla.Major <= 12 AndAlso
McLaunchJavaSelected.MajorVersion <= 8 AndAlso McLaunchJavaSelected.Version.Revision >= 200 AndAlso McLaunchJavaSelected.Version.Revision <= 321 AndAlso
Not McInstanceSelected.Version.HasOptiFine AndAlso Not McInstanceSelected.Version.HasForge Then
McLaunchLog($"已应用窗口大小过大修复（{McLaunchJavaSelected.Version.Revision}）")
GameSize.Width /= DPI / 96
GameSize.Height /= DPI / 96
@@ -1735,11 +1732,11 @@ NextVersion:
GameArguments.Add("${resolution_height}", Math.Round(GameSize.Height))
'Assets 相关参数
GameArguments.Add("${game_assets}", ShortenPath(PathMcFolder & "assets\virtual\legacy")) '1.5.2 的 pre-1.6 资源索引应与 legacy 合并
GameArguments.Add("${assets_index_name}", McAssetsGetIndexName(Version))
GameArguments.Add("${game_assets}", ShortenPath(McFolderSelected & "assets\virtual\legacy")) '1.5.2 的 pre-1.6 资源索引应与 legacy 合并
GameArguments.Add("${assets_index_name}", McAssetsGetIndexName(Instance))
'支持库参数
Dim LibList As List(Of McLibToken) = McLibListGet(Version, True)
Dim LibList As List(Of McLibToken) = McLibListGet(Instance, True)
Loader.Output = LibList
Dim CpStrings As New List(Of String)
Dim OptiFineCp As String = Nothing
@@ -1827,7 +1824,7 @@ NextVersion:
''' 获取 Natives 文件夹路径，不以 \ 结尾。
''' </summary>
Private Function GetNativesFolder() As String
Dim Result As String = McVersionCurrent.Path & McVersionCurrent.Name & "-natives"
Dim Result As String = McInstanceSelected.PathVersion & McInstanceSelected.Name & "-natives"
If Not (IsGBKEncoding OrElse Result.IsASCII()) Then
Result = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\bin\natives"
If Not Result.IsASCII() Then
@@ -1844,7 +1841,7 @@ NextVersion:
Private Sub McLaunchPrerun()
'要求 Java 使用高性能显卡
'使用高性能显卡
If Setup.Get("LaunchAdvanceGraphicCard") Then
Try
SetGPUPreference(McLaunchJavaSelected.PathJava)
@@ -1871,7 +1868,7 @@ NextVersion:
Try
'确保可用
If Not McLoginLoader.Output.Type = "Microsoft" Then Exit Try
McFolderLauncherProfilesJsonCreate(PathMcFolder)
McFolderLauncherProfilesJsonCreate(McFolderSelected)
'构建需要替换的 Json 对象
Dim ReplaceJsonString As String = "
{
@@ -1893,15 +1890,15 @@ NextVersion:
}"
Dim ReplaceJson As JObject = GetJson(ReplaceJsonString)
'更新文件
Dim Profiles As JObject = GetJson(ReadFile(PathMcFolder & "launcher_profiles.json"))
Dim Profiles As JObject = GetJson(ReadFile(McFolderSelected & "launcher_profiles.json"))
Profiles.Merge(ReplaceJson)
WriteFile(PathMcFolder & "launcher_profiles.json", Profiles.ToString, Encoding:=Encoding.GetEncoding("GB18030"))
WriteFile(McFolderSelected & "launcher_profiles.json", Profiles.ToString, Encoding:=Encoding.GetEncoding("GB18030"))
McLaunchLog("已更新 launcher_profiles.json")
Catch ex As Exception
Log(ex, "更新 launcher_profiles.json 失败，将在删除文件后重试")
Try
File.Delete(PathMcFolder & "launcher_profiles.json")
McFolderLauncherProfilesJsonCreate(PathMcFolder)
File.Delete(McFolderSelected & "launcher_profiles.json")
McFolderLauncherProfilesJsonCreate(McFolderSelected)
'构建需要替换的 Json 对象
Dim ReplaceJsonString As String = "
{
@@ -1923,9 +1920,9 @@ NextVersion:
}"
Dim ReplaceJson As JObject = GetJson(ReplaceJsonString)
'更新文件
Dim Profiles As JObject = GetJson(ReadFile(PathMcFolder & "launcher_profiles.json"))
Dim Profiles As JObject = GetJson(ReadFile(McFolderSelected & "launcher_profiles.json"))
Profiles.Merge(ReplaceJson)
WriteFile(PathMcFolder & "launcher_profiles.json", Profiles.ToString, Encoding:=Encoding.GetEncoding("GB18030"))
WriteFile(McFolderSelected & "launcher_profiles.json", Profiles.ToString, Encoding:=Encoding.GetEncoding("GB18030"))
McLaunchLog("已在删除后更新 launcher_profiles.json")
Catch exx As Exception
Log(exx, "更新 launcher_profiles.json 失败", LogLevel.Feedback)
@@ -1933,10 +1930,10 @@ NextVersion:
End Try
'更新 options.txt
Dim SetupFileAddress As String = McVersionCurrent.PathIndie & "options.txt"
Dim SetupFileAddress As String = McInstanceSelected.PathIndie & "options.txt"
If Not File.Exists(SetupFileAddress) Then
'Yosbr Mod 兼容（#2385）：https://www.curseforge.com/minecraft/mc-mods/yosbr
Dim YosbrFileAddress As String = McVersionCurrent.PathIndie & "config\yosbr\options.txt"
Dim YosbrFileAddress As String = McInstanceSelected.PathIndie & "config\yosbr\options.txt"
If File.Exists(YosbrFileAddress) Then
McLaunchLog("将修改 Yosbr Mod 中的 options.txt")
SetupFileAddress = YosbrFileAddress
@@ -1951,9 +1948,9 @@ NextVersion:
'1.11 ~ 12：zh_cn 时正常，zh_CN 时虽然显示了中文但语言设置会错误地显示选择英文
'1.13+ ：zh_cn 时正常，zh_CN 时自动切换为英文
Dim CurrentLang As String = ReadIni(SetupFileAddress, "lang", "none")
Dim RequiredLang As String = If(CurrentLang = "none" OrElse Not Directory.Exists(McVersionCurrent.PathIndie & "saves"), '#3844，整合包可能已经自带了 options.txt
Dim RequiredLang As String = If(CurrentLang = "none" OrElse Not Directory.Exists(McInstanceSelected.PathIndie & "saves"), '#3844，整合包可能已经自带了 options.txt
If(Setup.Get("ToolHelpChinese"), "zh_cn", "en_us"), CurrentLang.ToLower)
If McVersionCurrent.Version.McCodeMain < 12 Then '注意老版本（包含 MC 1.1）的 McCodeMain 可能为 -1
If Not McInstanceSelected.Version.Vaild OrElse McInstanceSelected.Version.Vanilla.Major <= 10 Then
'将最后两位改为大写，前面的部分保留
RequiredLang = RequiredLang.Substring(0, RequiredLang.Length - 2) & RequiredLang.Substring(RequiredLang.Length - 2).ToUpper
End If
@@ -1965,7 +1962,7 @@ NextVersion:
McLaunchLog($"已将语言从 {CurrentLang} 修改为 {RequiredLang}")
End If
''如果是初次设置，一并修改 forceUnicodeFont
'If Setup.Get("ToolHelpChinese") AndAlso (CurrentLang = "none" OrElse Not Directory.Exists(McVersionCurrent.PathIndie & "saves")) Then
'If Setup.Get("ToolHelpChinese") AndAlso (CurrentLang = "none" OrElse Not Directory.Exists(McInstanceSelected.PathIndie & "saves")) Then
' WriteIni(SetupFileAddress, "forceUnicodeFont", "true")
' McLaunchLog("已开启 forceUnicodeFont")
'End If
@@ -1982,7 +1979,7 @@ NextVersion:
End Try
'离线皮肤 Alex 警告
If McVersionCurrent.Version.McCodeMain <= 7 AndAlso McVersionCurrent.Version.McCodeMain >= 2 AndAlso '1.2 ~ 1.7
If McInstanceSelected.Version.Vanilla.Major <= 7 AndAlso McInstanceSelected.Version.Vanilla.Major >= 2 AndAlso '1.2 ~ 1.7
McLoginLoader.Input.Type = McLoginType.Legacy AndAlso '离线登录
(Setup.Get("LaunchSkinType") = 2 OrElse '强制 Alex
(Setup.Get("LaunchSkinType") = 4 AndAlso Setup.Get("LaunchSkinSlim"))) Then '或选用 Alex 皮肤
@@ -1991,17 +1988,17 @@ NextVersion:
'离线皮肤资源包
Try
Directory.CreateDirectory(McVersionCurrent.PathIndie & "resourcepacks\")
Dim ZipFileAddress As String = McVersionCurrent.PathIndie & "resourcepacks\PCL2 Skin.zip"
Dim NewTypeSetup As Boolean = McVersionCurrent.Version.McCodeMain >= 13 OrElse McVersionCurrent.Version.McCodeMain < 6
Directory.CreateDirectory(McInstanceSelected.PathIndie & "resourcepacks\")
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 Setup.Get("LaunchSkinType") = 4 AndAlso File.Exists(PathAppdata & "CustomSkin.png") Then
Directory.CreateDirectory(PathTemp)
Dim MetaFileAddress As String = PathTemp & "pack.mcmeta"
Dim PackPicAddress As String = PathTemp & "pack.png"
Dim PackFormat As Integer
Select Case McVersionCurrent.Version.McCodeMain
Select Case McInstanceSelected.Version.Vanilla.Major
Case 0, 1, 2, 3, 4, 5
'更早的版本没有资源包；如果判断失败该值为 -1，不会跑到这
'更早的版本没有资源包
McLaunchLog("Minecraft 版本过老，尚不支持自定义离线皮肤")
GoTo IgnoreCustomSkin
Case 6, 7, 8
@@ -2019,24 +2016,24 @@ NextVersion:
Case 17
PackFormat = 7
Case 18
If McVersionCurrent.Version.McCodeSub <= 2 Then
If McInstanceSelected.Version.Vanilla.Minor <= 2 Then
PackFormat = 8
Else
PackFormat = 9
End If
Case 19
If McVersionCurrent.Version.McCodeSub <= 3 Then
If McInstanceSelected.Version.Vanilla.Minor <= 3 Then
PackFormat = 9
Else
PackFormat = 12
End If
Case 20
If McVersionCurrent.Version.McCodeSub <= 1 Then
If McInstanceSelected.Version.Vanilla.Minor <= 1 Then
PackFormat = 15
Else
PackFormat = 17
End If
Case Else '快照版是 99
Case Else '快照版是 9999
PackFormat = 17
'https://zh.minecraft.wiki/w/数据包#数据包版本
End Select
@@ -2046,7 +2043,7 @@ NextVersion:
Bit.Save(PackPicAddress)
WriteFile(MetaFileAddress, "{""pack"":{""pack_format"":" & PackFormat & ",""description"":""PCL 自定义离线皮肤资源包""}}")
Dim Skin As New MyBitmap(PathAppdata & "CustomSkin.png")
If (McVersionCurrent.Version.McCodeMain = 6 OrElse McVersionCurrent.Version.McCodeMain = 7) AndAlso Skin.Pic.Height = 64 Then
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
@@ -2057,22 +2054,13 @@ NextVersion:
ZipAr.CreateEntryFromFile(MetaFileAddress, "pack.mcmeta")
ZipAr.CreateEntryFromFile(PackPicAddress, "pack.png")
'1.19.3+ 使用复杂版本的替换
Dim IsOldType As Boolean
Select Case McVersionCurrent.Version.McCodeMain
Case Is < 19
IsOldType = True
Case 19
IsOldType = McVersionCurrent.Version.McCodeSub <= 2
Case Else
IsOldType = False
End Select
If IsOldType Then
ZipAr.CreateEntryFromFile(Path & "PCL\CustomSkin_Cliped.png", "assets/minecraft/textures/entity/" & If(Setup.Get("LaunchSkinSlim"), "alex.png", "steve.png"))
Else
If McInstanceSelected.Version.Vanilla >= New Version(19, 0, 3) Then
For Each SkinName In {"alex", "ari", "efe", "kai", "makena", "noor", "steve", "sunny", "zuri"}
ZipAr.CreateEntryFromFile(Path & "PCL\CustomSkin_Cliped.png",
$"assets/minecraft/textures/entity/player/{If(Setup.Get("LaunchSkinSlim"), "slim", "wide")}/{SkinName}.png")
Next
Else
ZipAr.CreateEntryFromFile(Path & "PCL\CustomSkin_Cliped.png", "assets/minecraft/textures/entity/" & If(Setup.Get("LaunchSkinSlim"), "alex.png", "steve.png"))
End If
End Using
End Using
@@ -2131,24 +2119,24 @@ IgnoreCustomSkin:
'获取自定义命令
Dim CustomCommandGlobal As String = Setup.Get("LaunchAdvanceRun")
If CustomCommandGlobal <> "" Then CustomCommandGlobal = ArgumentReplace(CustomCommandGlobal)
Dim CustomCommandVersion As String = Setup.Get("VersionAdvanceRun", Version:=McVersionCurrent)
Dim CustomCommandVersion As String = Setup.Get("VersionAdvanceRun", Instance:=McInstanceSelected)
If CustomCommandVersion <> "" Then CustomCommandVersion = ArgumentReplace(CustomCommandVersion)
'输出 bat
Try
Dim CmdString As String =
$"{If(McLaunchJavaSelected.VersionCode > 8, "chcp 65001>nul" & vbCrLf, "")}" &
$"{If(McLaunchJavaSelected.MajorVersion > 8, "chcp 65001>nul" & vbCrLf, "")}" &
"@echo off" & vbCrLf &
$"title 启动 - {McVersionCurrent.Name}" & vbCrLf &
$"title 启动 - {McInstanceSelected.Name}" & vbCrLf &
"echo 游戏正在启动，请稍候。" & vbCrLf &
$"cd /D ""{ShortenPath(McVersionCurrent.PathIndie)}""" & vbCrLf &
$"cd /D ""{ShortenPath(McInstanceSelected.PathIndie)}""" & vbCrLf &
CustomCommandGlobal & vbCrLf &
CustomCommandVersion & vbCrLf &
$"""{McLaunchJavaSelected.PathJava}"" {McLaunchArgument}" & vbCrLf &
"echo 游戏已退出。" & vbCrLf &
"pause"
WriteFile(If(CurrentLaunchOptions.SaveBatch, Path & "PCL\LatestLaunch.bat"), FilterAccessToken(CmdString, "F"),
Encoding:=If(McLaunchJavaSelected.VersionCode > 8, Encoding.UTF8, Encoding.Default))
Encoding:=If(McLaunchJavaSelected.MajorVersion > 8, Encoding.UTF8, Encoding.Default))
If CurrentLaunchOptions.SaveBatch IsNot Nothing Then
McLaunchLog("导出启动脚本完成，强制结束启动过程")
AbortHint = "导出启动脚本成功！"
@@ -2169,7 +2157,7 @@ IgnoreCustomSkin:
CustomProcess = StartProcess(New ProcessStartInfo With {
.FileName = "cmd.exe",
.Arguments = $"/c ""{CustomCommandGlobal}""",
.WorkingDirectory = PathMcFolder,
.WorkingDirectory = McFolderSelected,
.UseShellExecute = False,
.CreateNoWindow = True
})
@@ -2194,11 +2182,11 @@ IgnoreCustomSkin:
CustomProcess = StartProcess(New ProcessStartInfo With {
.FileName = "cmd.exe",
.Arguments = $"/c ""{CustomCommandVersion}""",
.WorkingDirectory = PathMcFolder,
.WorkingDirectory = McFolderSelected,
.UseShellExecute = False,
.CreateNoWindow = True
})
If Setup.Get("VersionAdvanceRunWait", Version:=McVersionCurrent) Then
If Setup.Get("VersionAdvanceRunWait", Instance:=McInstanceSelected) Then
Do Until CustomProcess.HasExited OrElse Loader.IsAborted
Thread.Sleep(10)
Loop
@@ -2225,10 +2213,10 @@ IgnoreCustomSkin:
If Not String.IsNullOrEmpty(PathEnv) Then Paths.AddRange(PathEnv.Split(";"))
Paths.Add(ShortenPath(McLaunchJavaSelected.PathFolder))
StartInfo.EnvironmentVariables("Path") = Join(Paths.Distinct.ToList, ";")
StartInfo.EnvironmentVariables("appdata") = ShortenPath(PathMcFolder)
StartInfo.EnvironmentVariables("appdata") = ShortenPath(McFolderSelected)
'设置其他参数
StartInfo.WorkingDirectory = McVersionCurrent.PathIndie
StartInfo.WorkingDirectory = McInstanceSelected.PathIndie
StartInfo.UseShellExecute = False
StartInfo.RedirectStandardOutput = True
StartInfo.RedirectStandardError = True
@@ -2267,14 +2255,14 @@ IgnoreCustomSkin:
McLaunchLog("")
McLaunchLog("~ 基础参数 ~")
McLaunchLog("PCL 版本：" & VersionDisplayName & " (" & VersionCode & ")")
McLaunchLog("游戏版本：" & McVersionCurrent.Version.ToString & "（识别为 1." & McVersionCurrent.Version.McCodeMain & "." & McVersionCurrent.Version.McCodeSub & "）")
McLaunchLog("资源版本：" & McAssetsGetIndexName(McVersionCurrent))
McLaunchLog("版本继承：" & If(McVersionCurrent.InheritVersion = "", "无", McVersionCurrent.InheritVersion))
McLaunchLog("分配的内存：" & PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) & " GB（" & Math.Round(PageVersionSetup.GetRam(McVersionCurrent, Not McLaunchJavaSelected.Is64Bit) * 1024) & " MB）")
McLaunchLog("MC 文件夹：" & PathMcFolder)
McLaunchLog("版本文件夹：" & McVersionCurrent.Path)
McLaunchLog("版本隔离：" & (McVersionCurrent.PathIndie = McVersionCurrent.Path))
McLaunchLog("HMCL 格式：" & McVersionCurrent.IsHmclFormatJson)
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("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())
@@ -2288,12 +2276,12 @@ IgnoreCustomSkin:
McLaunchLog("")
'获取窗口标题
Dim WindowTitle As String = Setup.Get("VersionArgumentTitle", Version:=McVersionCurrent)
Dim WindowTitle As String = Setup.Get("VersionArgumentTitle", Instance:=McInstanceSelected)
If WindowTitle = "" Then WindowTitle = Setup.Get("LaunchArgumentTitle")
WindowTitle = ArgumentReplace(WindowTitle, ReplaceTime:=False)
'初始化等待
Dim Watcher As New Watcher(Loader, McVersionCurrent, WindowTitle)
Dim Watcher As New Watcher(Loader, McInstanceSelected, WindowTitle)
McLaunchWatcher = Watcher
'等待
Plain Craft Launcher 2/Modules/Minecraft/ModMinecraft.vb
+821 -834
View File
File diff suppressed because it is too large Load Diff
Plain Craft Launcher 2/Modules/Minecraft/ModMod.vb
+92 -489
View File
@@ -1,7 +1,7 @@
Imports System.IO.Compression
Public Module ModMod
Private Const LocalModCacheVersion As Integer = 8
Private Const LocalModCacheVersion As Integer = 10
Public Class McMod
@@ -46,10 +46,7 @@ Public Module ModMod
''' </summary>
Public ReadOnly Property State As McModState
Get
Load()
If Not IsFileAvailable Then
Return McModState.Unavailable
ElseIf Path.EndsWithF(".disabled", True) OrElse Path.EndsWithF(".old", True) Then
If Path.EndsWithF(".disabled", True) OrElse Path.EndsWithF(".old", True) Then
Return McModState.Disabled
Else
Return McModState.Fine
@@ -59,7 +56,6 @@ Public Module ModMod
Public Enum McModState As Integer
Fine = 0
Disabled = 1
Unavailable = 2
End Enum
#End Region
@@ -67,12 +63,17 @@ Public Module ModMod
#Region "信息项"
''' <summary>
''' Mod 的名称。若不可用则为 ModID 或无扩展的文件名。
''' 当任何信息在初始化后更新时触发。
''' </summary>
Public Property Name As String
Public Event OnUpdate(sender As McMod)
''' <summary>
''' Mod 的可读名称。
''' 可能为无扩展的文件名，但不会是 Nothing。
''' </summary>
Public Property DisplayName As String
Get
If _Name Is Nothing Then Load()
If _Name Is Nothing Then _Name = _ModId
If _Name Is Nothing Then _Name = CompFile?.DisplayName
If _Name Is Nothing Then _Name = IO.Path.GetFileNameWithoutExtension(Path)
Return _Name
End Get
@@ -87,12 +88,10 @@ Public Module ModMod
''' <summary>
''' Mod 的描述信息。
''' 可能为 Nothing。
''' </summary>
Public Property Description As String
Get
If _Description Is Nothing Then Load()
If _Description Is Nothing AndAlso FileUnavailableReason IsNot Nothing Then _Description = FileUnavailableReason.Message
'If _Description Is Nothing Then _Description = Path
Return _Description
End Get
Set(value As String)
@@ -106,11 +105,12 @@ Public Module ModMod
Private _Description As String = Nothing
''' <summary>
''' Mod 的版本，不保证符合版本格式规范。
''' Mod 的版本。
''' 不保证符合版本格式规范，且可能为 Nothing。
''' </summary>
Public Property Version As String
Get
If _Version Is Nothing Then Load()
If _Version Is Nothing Then _Version = CompFile?.Version
Return _Version
End Get
Set(value As String)
@@ -121,167 +121,17 @@ Public Module ModMod
End Property
Public _Version As String = Nothing
''' <summary>
''' 用于依赖检查的 ModID。
''' </summary>
Public Property ModId As String
Get
If _ModId Is Nothing Then Load()
Return _ModId
End Get
Set(value As String)
If value Is Nothing Then Return
value = RegexSeek(value, "[0-9a-zA-Z_-]+")
If value Is Nothing OrElse value.Count <= 1 OrElse Val(value).ToString = value Then Return
If value.ContainsF("name", True) OrElse value.ContainsF("modid", True) Then Return
If Not PossibleModId.Contains(value) Then PossibleModId.Add(value)
If _ModId Is Nothing Then _ModId = value
End Set
End Property
Private _ModId As String = Nothing
''' <summary>
''' 其他可能的 ModID。
''' </summary>
Public PossibleModId As New List(Of String)
''' <summary>
''' Mod 的主页。
''' </summary>
Public Property Url As String
Get
If _Url Is Nothing Then Load()
Return _Url
End Get
Set(value As String)
If _Url Is Nothing AndAlso value IsNot Nothing AndAlso value.StartsWithF("http") Then
_Url = value
End If
End Set
End Property
Private _Url As String = Nothing
''' <summary>
''' Mod 的作者列表。
''' </summary>
Public Property Authors As String
Get
If _Authors Is Nothing Then Load()
Return _Authors
End Get
Set(value As String)
If _Authors Is Nothing AndAlso Not String.IsNullOrWhiteSpace(value) Then
_Authors = value
End If
End Set
End Property
Private _Authors As String = Nothing
''' <summary>
''' 依赖项，其中包括了 Minecraft 的版本要求。格式为 ModID - VersionRequirement，若无版本要求则为 Nothing。
''' </summary>
Public ReadOnly Property Dependencies As Dictionary(Of String, String)
Get
Load()
Return _Dependencies
End Get
End Property
Private _Dependencies As New Dictionary(Of String, String)
Private Sub AddDependency(ModID As String, Optional VersionRequirement As String = Nothing)
'确保信息正确
If ModID Is Nothing OrElse ModID.Count < 2 Then Return
ModID = ModID.ToLower
If ModID = "name" OrElse Val(ModID).ToString = ModID Then Return '跳过 name 与纯数字 id
If VersionRequirement Is Nothing OrElse ((Not VersionRequirement.Contains(".")) AndAlso (Not VersionRequirement.Contains("-"))) OrElse VersionRequirement.Contains("$") Then
VersionRequirement = Nothing
Else
If (Not VersionRequirement.StartsWithF("[")) AndAlso (Not VersionRequirement.StartsWithF("(")) AndAlso (Not VersionRequirement.EndsWithF("]")) AndAlso (Not VersionRequirement.EndsWithF(")")) Then VersionRequirement = "[" & VersionRequirement & ",)"
End If
'向依赖项中添加
If _Dependencies.ContainsKey(ModID) Then
If _Dependencies(ModID) Is Nothing Then _Dependencies(ModID) = VersionRequirement
Else
_Dependencies.Add(ModID, VersionRequirement)
End If
End Sub
#End Region
#Region "加载步骤标记"
'1. 进行文件可用性检查
' 成功：继续第二步。
' 失败：标记 FileUnavailableReason， 并停止后续加载。
''' <summary>
''' 是否已进行 Mod 文件的基础加载。（这包括第一步和第二步）
''' </summary>
Private IsLoaded As Boolean = False
''' <summary>
''' Mod 文件是否可被正常读取。
''' </summary>
Public ReadOnly Property IsFileAvailable As Boolean
Get
Load()
Return FileUnavailableReason Is Nothing
End Get
End Property
''' <summary>
''' Mod 文件出错的原因。若无错误，则为 Nothing。
''' </summary>
Public ReadOnly Property FileUnavailableReason As Exception
Get
Load()
Return _FileUnavailableReason
End Get
End Property
Private _FileUnavailableReason As Exception = Nothing
'2. 进行 .class 以外的信息获取
' 成功：标记 IsInfoWithoutClassAvailable。
' 失败：什么也不干。如果需要补充信息的话，检测到 IsInfoWithoutClassAvailable 为 False，会自动继续加载。
''' <summary>
''' 是否已在不获取 .class 文件的前提下完成了所需信息的加载。
''' </summary>
Private IsInfoWithoutClassAvailable As Boolean = False
'3. 尝试从 .class 文件中获取信息
' 成功：标记 IsInfoWithClassAvailable。
' 失败：什么也不干。
''' <summary>
''' 是否已进行 .class 文件的信息获取。
''' </summary>
Private IsInfoWithClassLoaded As Boolean = False
''' <summary>
''' 是否已在 .class 文件中完成了所需信息的加载。
''' </summary>
Private IsInfoWithClassAvailable As Boolean = False
#End Region
#Region "加载"
#Region "从 JAR 获取信息"
''' <summary>
''' 初始化所有数据。
''' 从 JAR 文件中获取 Mod 信息。
''' </summary>
Private Sub Init()
_Name = Nothing
_Description = Nothing
_Version = Nothing
_ModId = Nothing
PossibleModId = New List(Of String)
_Dependencies = New Dictionary(Of String, String)
IsLoaded = False
_FileUnavailableReason = Nothing
IsInfoWithClassLoaded = False
IsInfoWithClassAvailable = False
End Sub
''' <summary>
''' 进行文件可用性检查与 .class 以外的信息获取。
''' </summary>
Public Sub Load(Optional ForceReload As Boolean = False)
If IsLoaded AndAlso Not ForceReload Then Return
'初始化
Init()
Public Sub LoadMetadataFromJar()
Static IsLoaded As Boolean = False
If IsLoaded Then Return
IsLoaded = True
Dim Jar As ZipArchive = Nothing
Try
'基础可用性检查、打开 Jar 文件
@@ -289,24 +139,16 @@ Public Module ModMod
If Not File.Exists(Path) Then Throw New FileNotFoundException("未找到 Mod 文件（" & Path & "）")
Jar = New ZipArchive(New FileStream(Path, FileMode.Open))
'信息获取
LookupMetadata(Jar)
LoadMetadataFromJar(Jar)
Catch ex As UnauthorizedAccessException
Log(ex, "Mod 文件由于无权限无法打开（" & Path & "）", LogLevel.Developer)
_FileUnavailableReason = New UnauthorizedAccessException("没有读取此文件的权限，请尝试右键以管理员身份运行 PCL", ex)
Catch ex As Exception
Log(ex, "Mod 文件无法打开（" & Path & "）", LogLevel.Developer)
_FileUnavailableReason = ex
Finally
If Jar IsNot Nothing Then Jar.Dispose()
End Try
'完成标记
IsLoaded = True
End Sub
''' <summary>
''' 从 jar 文件中获取 Mod 信息。
''' </summary>
Private Sub LookupMetadata(Jar As ZipArchive)
Private Sub LoadMetadataFromJar(Jar As ZipArchive)
#Region "尝试使用 mcmod.info"
Try
@@ -327,45 +169,9 @@ Public Module ModMod
InfoObject = JsonObject("modList")(0)
End If
'从文件中获取 Mod 信息项
Name = InfoObject("name")
DisplayName = InfoObject("name")
Description = InfoObject("description")
Version = InfoObject("version")
Url = InfoObject("url")
ModId = InfoObject("modid")
Dim AuthorJson As JArray = InfoObject("authorList")
If AuthorJson IsNot Nothing Then
Dim Author As New List(Of String)
For Each Token In AuthorJson
Author.Add(Token.ToString)
Next
If Author.Any Then Authors = Join(Author, ", ")
End If
Dim Reqs As JArray = InfoObject("requiredMods")
If Reqs IsNot Nothing Then
For Each Token As String In Reqs
If Not String.IsNullOrEmpty(Token) Then
Token = Token.Substring(Token.IndexOfF(":") + 1)
If Token.Contains("@") Then
AddDependency(Token.Split("@")(0), Token.Split("@")(1))
Else
AddDependency(Token)
End If
End If
Next
End If
Reqs = InfoObject("dependancies")
If Reqs IsNot Nothing Then
For Each Token As String In Reqs
If Not String.IsNullOrEmpty(Token) Then
Token = Token.Substring(Token.IndexOfF(":") + 1)
If Token.Contains("@") Then
AddDependency(Token.Split("@")(0), Token.Split("@")(1))
Else
AddDependency(Token)
End If
End If
Next
End If
Catch ex As Exception
Log(ex, "读取 mcmod.info 时出现未知错误（" & Path & "）", LogLevel.Developer)
End Try
@@ -383,37 +189,9 @@ Public Module ModMod
Dim FabricObject As JObject = GetJson(FabricText)
GotFabric:
'从文件中获取 Mod 信息项
If FabricObject.ContainsKey("name") Then Name = FabricObject("name")
If FabricObject.ContainsKey("name") Then DisplayName = FabricObject("name")
If FabricObject.ContainsKey("version") Then Version = FabricObject("version")
If FabricObject.ContainsKey("description") Then Description = FabricObject("description")
If FabricObject.ContainsKey("id") Then ModId = FabricObject("id")
If FabricObject.ContainsKey("contact") Then Url = If(FabricObject("contact")("homepage"), "")
Dim AuthorJson As JArray = FabricObject("authors")
If AuthorJson IsNot Nothing Then
Dim Author As New List(Of String)
For Each Token In AuthorJson
Author.Add(Token.ToString)
Next
If Author.Any Then Authors = Join(Author, ", ")
End If
'If (Not FabricObject.ContainsKey("serverSideOnly")) OrElse FabricObject("serverSideOnly")("value").ToObject(Of Boolean) = False Then
' '添加 Minecraft 依赖
' Dim DepMinecraft As String = If(If(FabricObject("acceptedMinecraftVersions") IsNot Nothing, FabricObject("acceptedMinecraftVersions")("value"), ""), "")
' If DepMinecraft <> "" Then AddDependency("minecraft", DepMinecraft)
' '添加其他依赖
' Dim Deps As String = If(If(FabricObject("dependencies") IsNot Nothing, FabricObject("dependencies")("value"), ""), "")
' If Deps <> "" Then
' For Each Dep In Deps.Split(";")
' If Dep = "" OrElse Not Dep.StartsWithF("required-") Then Continue For
' Dep = Dep.Substring(Dep.IndexOfF(":") + 1)
' If Dep.Contains("@") Then
' AddDependency(Dep.Split("@")(0), Dep.Split("@")(1))
' Else
' AddDependency(Dep)
' End If
' Next
' End If
'End If
'加载成功
GoTo Finished
Catch ex As Exception
@@ -500,22 +278,9 @@ GotFabric:
End If
Next
If ModEntry Is Nothing OrElse Not ModEntry.ContainsKey("modId") Then Exit Try
ModId = ModEntry("modId")
If _ModId Is Nothing Then Exit Try '设置了无效的 ModID
If ModEntry.ContainsKey("displayName") Then Name = ModEntry("displayName")
If ModEntry.ContainsKey("displayName") Then DisplayName = ModEntry("displayName")
If ModEntry.ContainsKey("description") Then Description = ModEntry("description")
If ModEntry.ContainsKey("version") Then Version = ModEntry("version")
If TomlData(0).Value.ContainsKey("displayURL") Then Url = TomlData(0).Value("displayURL")
If TomlData(0).Value.ContainsKey("authors") Then Authors = TomlData(0).Value("authors")
For Each TomlSubData In TomlData
If TomlSubData.Key.ToLower = $"dependencies.{ModId.ToLower}" Then
Dim DepEntry As Dictionary(Of String, Object) = TomlSubData.Value
If DepEntry.ContainsKey("modId") AndAlso DepEntry.ContainsKey("mandatory") AndAlso DepEntry("mandatory") AndAlso
DepEntry.ContainsKey("side") AndAlso Not DepEntry("side").ToString.ToLower = "server" Then
AddDependency(DepEntry("modId"), If(DepEntry.ContainsKey("versionRange"), DepEntry("versionRange"), Nothing))
End If
End If
Next
'加载成功
GoTo Finished
Catch ex As Exception
@@ -551,41 +316,16 @@ GotFabric:
Exit Try
Got:
'从文件中获取 Mod 信息项
If FmlObject.ContainsKey("useMetadata") AndAlso If(FmlObject("useMetadata")("value"), "").ToString.ToLower = "true" Then
'要求使用 mcmod.info 中的信息
Dim value As String = FmlObject("modid")("value")
If value Is Nothing Then Exit Try
value = RegexSeek(value.ToLower, "[0-9a-z_]+")
If value IsNot Nothing AndAlso value.ToLower <> "name" AndAlso value.Count > 1 AndAlso Val(value).ToString <> value Then
If Not PossibleModId.Contains(value) Then PossibleModId.Add(value)
End If
Exit Try
End If
If FmlObject.ContainsKey("name") Then Name = FmlObject("name")("value")
If FmlObject.ContainsKey("name") Then DisplayName = FmlObject("name")("value")
If FmlObject.ContainsKey("version") Then Version = FmlObject("version")("value")
If FmlObject.ContainsKey("modid") Then ModId = FmlObject("modid")("value")
If (Not FmlObject.ContainsKey("serverSideOnly")) OrElse FmlObject("serverSideOnly")("value").ToObject(Of Boolean) = False Then
'添加 Minecraft 依赖
Dim DepMinecraft As String = If(If(FmlObject("acceptedMinecraftVersions") IsNot Nothing, FmlObject("acceptedMinecraftVersions")("value"), ""), "")
If DepMinecraft <> "" Then AddDependency("minecraft", DepMinecraft)
'添加其他依赖
Dim Deps As String = If(If(FmlObject("dependencies") IsNot Nothing, FmlObject("dependencies")("value"), ""), "")
If Deps <> "" Then
For Each Dep In Deps.Split(";")
If Dep = "" OrElse Not Dep.StartsWithF("required-") Then Continue For
Dep = Dep.Substring(Dep.IndexOfF(":") + 1)
If Dep.Contains("@") Then
AddDependency(Dep.Split("@")(0), Dep.Split("@")(1))
Else
AddDependency(Dep)
End If
Next
End If
End If
'加载成功
GoTo Finished
Catch ex As Exception
Log(ex, "读取 fml_cache_annotation.json 时出现未知错误（" & Path & "）", LogLevel.Developer)
End Try
#End Region
Return '没能成功获取任何信息
Finished:
#Region "将 Version 代号转换为 META-INF 中的版本"
If _Version = "version" Then
@@ -606,6 +346,7 @@ Finished:
End If
If _Version IsNot Nothing AndAlso Not (_Version.Contains(".") OrElse _Version.Contains("-")) Then Version = Nothing
#End Region
RaiseEvent OnUpdate(Me)
End Sub
@@ -613,11 +354,6 @@ Finished:
#Region "网络信息"
''' <summary>
''' 当任何网络信息更新时触发。
''' </summary>
Public Event OnCompUpdate(sender As McMod)
''' <summary>
''' 该 Mod 关联的网络项目。
''' </summary>
@@ -627,7 +363,7 @@ Finished:
End Get
Set(value As CompProject)
_Comp = value
RaiseEvent OnCompUpdate(Me)
RaiseEvent OnUpdate(Me)
End Set
End Property
Private _Comp As CompProject
@@ -646,7 +382,7 @@ Finished:
End Get
Set(value As CompFile)
_UpdateFile = value
RaiseEvent OnCompUpdate(Me)
RaiseEvent OnUpdate(Me)
End Set
End Property
Private _UpdateFile As CompFile
@@ -688,7 +424,7 @@ Finished:
''' </summary>
Public ReadOnly Property CanUpdate As Boolean
Get
Return Not Setup.Get("UiHiddenFunctionModUpdate") AndAlso Not Setup.Get("VersionAdvanceDisableModUpdate", Version:=PageVersionLeft.Version) AndAlso ChangelogUrls.Any()
Return Not Setup.Get("UiHiddenFunctionModUpdate") AndAlso Not Setup.Get("VersionAdvanceDisableModUpdate", Instance:=PageInstanceLeft.Instance) AndAlso ChangelogUrls.Any()
End Get
End Property
@@ -787,10 +523,10 @@ Finished:
#End Region
''' <summary>
''' 是否可能为前置 Mod。
''' 是否可能为前置 Mod。目前非常不准确。
''' </summary>
Public Function IsPresetMod() As Boolean
Return Not Dependencies.Any() AndAlso Name IsNot Nothing AndAlso (Name.ToLower.Contains("core") OrElse Name.ToLower.Contains("lib"))
Return DisplayName IsNot Nothing AndAlso (DisplayName.ToLower.Contains("core") OrElse DisplayName.ToLower.Contains("lib"))
End Function
''' <summary>
@@ -811,21 +547,21 @@ Finished:
Public McModLoader As New LoaderTask(Of String, List(Of McMod))("Mod List Loader", AddressOf McModLoad)
Private Sub McModLoad(Loader As LoaderTask(Of String, List(Of McMod)))
Try
RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.ShowProgress = False)
RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.ShowProgress = False)
'等待 Mod 更新完成
If PageVersionMod.UpdatingVersions.Contains(Loader.Input) Then
If PageInstanceMod.UpdatingInstanceModFolders.Contains(Loader.Input) Then
Log($"[Mod] 等待 Mod 更新完成后才能继续加载 Mod 列表：" & Loader.Input)
Try
RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.Text = "正在更新 Mod")
Do Until Not PageVersionMod.UpdatingVersions.Contains(Loader.Input)
RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.Text = "正在更新 Mod")
Do Until Not PageInstanceMod.UpdatingInstanceModFolders.Contains(Loader.Input)
If Loader.IsAborted Then Return
Thread.Sleep(100)
Loop
Finally
RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.Text = "正在加载 Mod 列表")
RunInUiWait(Sub() If FrmInstanceMod IsNot Nothing Then FrmInstanceMod.Load.Text = "正在加载 Mod 列表")
End Try
FrmVersionMod.LoaderRun(LoaderFolderRunType.UpdateOnly)
FrmInstanceMod.LoaderRun(LoaderFolderRunType.UpdateOnly)
End If
'获取 Mod 文件夹下的可用文件列表
@@ -835,9 +571,9 @@ Finished:
For Each File As FileInfo In EnumerateFiles(Loader.Input)
If File.DirectoryName.ToLower & "\" <> RawName Then
'仅当 Forge 1.13- 且文件夹名与版本号相同时，才加载该子文件夹下的 Mod
If Not (PageVersionLeft.Version IsNot Nothing AndAlso PageVersionLeft.Version.Version.HasForge AndAlso
PageVersionLeft.Version.Version.McCodeMain < 13 AndAlso
File.Directory.Name = $"1.{PageVersionLeft.Version.Version.McCodeMain}.{PageVersionLeft.Version.Version.McCodeSub}") Then
If Not (PageInstanceLeft.Instance IsNot Nothing AndAlso PageInstanceLeft.Instance.Version.HasForge AndAlso
PageInstanceLeft.Instance.Version.Vanilla.Major < 13 AndAlso
File.Directory.Name = $"1.{PageInstanceLeft.Instance.Version.Vanilla.Major}.{PageInstanceLeft.Instance.Version.Vanilla.Build}") Then
Continue For
End If
End If
@@ -845,10 +581,6 @@ Finished:
Next
End If
'确定是否显示进度
Loader.Progress = 0.05
If ModFileList.Count > 50 Then RunInUi(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.ShowProgress = True)
'获取本地文件缓存
Dim CachePath As String = PathTemp & "Cache\LocalMod.json"
Dim Cache As New JObject
@@ -869,13 +601,9 @@ Finished:
'加载 Mod 列表
Dim ModList As New List(Of McMod)
Dim ModUpdateList As New List(Of McMod)
For Each ModFile As FileInfo In ModFileList
Loader.Progress += 0.94 / ModFileList.Count
If Loader.IsAborted Then Return
'加载 McMod 对象
Dim ModEntry As New McMod(ModFile.FullName)
ModEntry.Load()
Dim DumpMod As McMod = ModList.FirstOrDefault(Function(m) m.RawFileName = ModEntry.RawFileName)
If DumpMod IsNot Nothing Then
Dim DisabledMod As McMod = If(DumpMod.State = McMod.McModState.Disabled, DumpMod, ModEntry)
@@ -884,31 +612,16 @@ Finished:
Continue For
Else
ModList.Remove(DisabledMod)
ModUpdateList.Remove(DisabledMod)
End If
End If
ModList.Add(ModEntry)
'读取 Comp 缓存
If ModEntry.State = McMod.McModState.Unavailable Then Continue For
Dim CacheKey = ModEntry.ModrinthHash & PageVersionLeft.Version.Version.McName & GetTargetModLoaders().Join("")
If Cache.ContainsKey(CacheKey) Then
ModEntry.FromJson(Cache(CacheKey))
'如果缓存中的信息在 6 小时以内更新过，则无需重新获取
If ModEntry.CompLoaded AndAlso Date.Now - Cache(CacheKey)("Comp")("CacheTime").ToObject(Of Date) < New TimeSpan(6, 0, 0) Then Continue For
End If
ModUpdateList.Add(ModEntry)
Next
Loader.Progress = 0.99
Log($"[Mod] 共有 {ModList.Count} 个 Mod，其中 {ModUpdateList.Where(Function(m) m.Comp Is Nothing).Count} 个需要联网获取信息，{ModUpdateList.Where(Function(m) m.Comp IsNot Nothing).Count} 个需要更新信息")
Log($"[Mod] 共发现 {ModList.Count} 个 Mod")
'排序
ModList = ModList.Sort(
Function(Left As McMod, Right As McMod) As Boolean
If (Left.State = McMod.McModState.Unavailable) <> (Right.State = McMod.McModState.Unavailable) Then
Return Left.State = McMod.McModState.Unavailable
Else
Return Not Right.FileName.CompareTo(Left.FileName)
End If
ModList = ModList.SortByComparison(
Function(Left, Right) As Boolean
Return Not Right.FileName.CompareTo(Left.FileName)
End Function)
'回设
@@ -916,10 +629,8 @@ Finished:
Loader.Output = ModList
'开始联网加载
If ModUpdateList.Any() Then
'TODO: 添加信息获取中提示
McModDetailLoader.Start(New KeyValuePair(Of List(Of McMod), JObject)(ModUpdateList, Cache), IsForceRestart:=True)
End If
'TODO: 添加信息获取中提示
McModDetailLoader.Start(New KeyValuePair(Of List(Of McMod), JObject)(ModList, Cache), IsForceRestart:=True)
Catch ex As Exception
Log(ex, "Mod 列表加载失败", LogLevel.Debug)
@@ -929,15 +640,31 @@ Finished:
'联网加载 Mod 详情
Public McModDetailLoader As New LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer)("Mod List Detail Loader", AddressOf McModDetailLoad)
Private Sub McModDetailLoad(Loader As LoaderTask(Of KeyValuePair(Of List(Of McMod), JObject), Integer))
Dim Mods As List(Of McMod) = Loader.Input.Key
Dim Mods As New List(Of McMod)
Dim Cache As JObject = Loader.Input.Value
'读取 Comp 缓存，获取需要更新的 Mod 列表
For Each ModEntry As McMod In Loader.Input.Key
If Loader.IsAborted Then Return
Dim CacheKey = ModEntry.ModrinthHash & PageInstanceLeft.Instance.Version.VanillaName & GetTargetModLoaders().Join("")
If Cache.ContainsKey(CacheKey) Then
ModEntry.FromJson(Cache(CacheKey))
'如果缓存中的信息在 6 小时以内更新过，则无需重新获取
If ModEntry.CompLoaded AndAlso Date.Now - Cache(CacheKey)("Comp")("CacheTime").ToObject(Of Date) < New TimeSpan(6, 0, 0) Then Continue For
End If
Mods.Add(ModEntry)
Next
Log($"[Mod] 有 {Mods.Where(Function(m) m.Comp Is Nothing).Count} 个 Mod 需要联网获取信息，{Mods.Where(Function(m) m.Comp IsNot Nothing).Count} 个 Mod 需要更新信息")
If Not Mods.Any Then
Loader.Input.Key.Where(Function(m) m.Version Is Nothing).ForEach(Sub(m) m.LoadMetadataFromJar()) '从 JAR 中获取缺失的版本信息（下面有另一个分支）
Return
End If
'获取作为检查目标的加载器和版本
'此处不应向下扩展检查的 MC 小版本，例如 Mod 在更新 1.16.5 后，对早期的 1.16.2 版本发布了修补补丁，这会导致 PCL 将 1.16.5 版本的 Mod 降级到 1.16.2
Dim TargetMcVersion As McVersionInfo = PageVersionLeft.Version.Version
Dim TargetMcVersion As McVersion = PageInstanceLeft.Instance.Version
Dim ModLoaders = GetTargetModLoaders()
Dim McVersion = TargetMcVersion.McName
Dim VanillaVersion = TargetMcVersion.VanillaName
'开始网络获取
Log($"[Mod] 目标加载器：{ModLoaders.Join("/")}，版本：{McVersion}")
Log($"[Mod] 目标加载器：{ModLoaders.Join("/")}，版本：{VanillaVersion}")
Dim EndedThreadCount As Integer = 0, IsFailed As Boolean = False
Dim CurrentTaskThread As Thread = Thread.CurrentThread
'从 Modrinth 获取信息
@@ -961,7 +688,11 @@ Finished:
ModrinthMapping(ProjectId).Add(Entry)
'记录对应的 CompFile
Dim File As New CompFile(ModrinthVersion(Entry.ModrinthHash), CompType.Mod)
If Entry.CompFile Is Nothing OrElse Entry.CompFile.ReleaseDate < File.ReleaseDate Then Entry.CompFile = File
If Entry.CompFile Is Nothing OrElse Entry.CompFile.ReleaseDate < File.ReleaseDate Then
Entry.CompFile = File
Else
Entry.CompFile.Version = File.Version '使用来自 Modrinth 的版本号
End If
Next
If Loader.IsAbortedWithThread(CurrentTaskThread) Then Return
Log($"[Mod] 需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息")
@@ -979,7 +710,7 @@ Finished:
'步骤 4：获取更新信息
Dim ModrinthUpdate As JObject = DlModRequest("https://api.modrinth.com/v2/version_files/update", HttpMethod.Post,
$"{{""hashes"": [""{ModrinthMapping.SelectMany(Function(l) l.Value.Select(Function(m) m.ModrinthHash)).Join(""",""")}""], ""algorithm"": ""sha1"",
""loaders"": [""{ModLoaders.Join(""",""").ToLower}""],""game_versions"": [""{McVersion}""]}}", "application/json")
""loaders"": [""{ModLoaders.Join(""",""").ToLower}""],""game_versions"": [""{VanillaVersion}""]}}", "application/json")
For Each Entry In Mods
If Not ModrinthUpdate.ContainsKey(Entry.ModrinthHash) OrElse Entry.CompFile Is Nothing Then Continue For
Dim UpdateFile As New CompFile(ModrinthUpdate(Entry.ModrinthHash), CompType.Mod)
@@ -988,11 +719,11 @@ Finished:
If Entry.CompFile.ReleaseDate >= UpdateFile.ReleaseDate OrElse Entry.CompFile.Hash = UpdateFile.Hash Then Continue For
'设置更新日志与更新文件
If Entry.UpdateFile IsNot Nothing AndAlso UpdateFile.Hash = Entry.UpdateFile.Hash Then '合并
Entry.ChangelogUrls.Add($"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?g={McVersion}")
Entry.ChangelogUrls.Add($"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?g={VanillaVersion}")
UpdateFile.DownloadUrls.AddRange(Entry.UpdateFile.DownloadUrls) '合并下载源
Entry.UpdateFile = UpdateFile '优先使用 Modrinth 的文件
ElseIf Entry.UpdateFile Is Nothing OrElse UpdateFile.ReleaseDate >= Entry.UpdateFile.ReleaseDate Then '替换
Entry.ChangelogUrls = New List(Of String) From {$"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?g={McVersion}"}
Entry.ChangelogUrls = New List(Of String) From {$"https://modrinth.com/mod/{ModrinthUpdate(Entry.ModrinthHash)("project_id")}/changelog?g={VanillaVersion}"}
Entry.UpdateFile = UpdateFile
End If
Next
@@ -1059,9 +790,9 @@ Finished:
For Each IndexEntry In ProjectJson("latestFilesIndexes")
If IndexEntry("modLoader") Is Nothing OrElse ModLoaders.Single <> IndexEntry("modLoader").ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配
Dim IndexVersion As String = IndexEntry("gameVersion")
If IndexVersion <> McVersion Then Continue For 'MC 版本匹配
If IndexVersion <> VanillaVersion Then Continue For 'MC 版本匹配
'由于 latestFilesIndexes 是按时间从新到老排序的，所以只需取第一个；如果需要检查多个 releaseType 下的文件，将 > -1 改为 = 1，但这应当并不会获取到更新的文件
If NewestVersion IsNot Nothing AndAlso VersionSortInteger(NewestVersion, IndexVersion) > -1 Then Continue For '只保留最新 MC 版本
If NewestVersion IsNot Nothing AndAlso CompareVersion(NewestVersion, IndexVersion) > -1 Then Continue For '只保留最新 MC 版本
If NewestVersion <> IndexVersion Then
NewestVersion = IndexVersion
NewestFileIds.Clear()
@@ -1111,6 +842,8 @@ Finished:
EndedThreadCount += 1
End Try
End Sub, "Mod List Detail Loader CurseForge")
'从 JAR 中获取缺失的版本信息（上面有另一个分支）
Loader.Input.Key.Where(Function(m) m.Version Is Nothing).ForEach(Sub(m) m.LoadMetadataFromJar())
'等待线程结束
Do Until EndedThreadCount = 2
Thread.Sleep(10)
@@ -1122,155 +855,25 @@ Finished:
If Not Mods.Any() Then Return
For Each Entry In Mods
Entry.CompLoaded = Not IsFailed
Cache(Entry.ModrinthHash & McVersion & ModLoaders.Join("")) = Entry.ToJson()
Cache(Entry.ModrinthHash & VanillaVersion & ModLoaders.Join("")) = Entry.ToJson()
Next
WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
'刷新边栏
If Loader.IsAborted Then Return
If FrmVersionMod?.Filter = PageVersionMod.FilterType.CanUpdate Then
RunInUi(Sub() FrmVersionMod?.RefreshUI()) '同步 “可更新” 列表 (#4677)
If FrmInstanceMod?.Filter = PageInstanceMod.FilterType.CanUpdate Then
RunInUi(Sub() FrmInstanceMod?.RefreshUI()) '同步 “可更新” 列表 (#4677)
Else
RunInUi(Sub() FrmVersionMod?.RefreshBars())
RunInUi(Sub() FrmInstanceMod?.RefreshBars())
End If
End Sub
Public Function GetTargetModLoaders() As List(Of CompModLoaderType)
Dim ModLoaders As New List(Of CompModLoaderType)
If PageVersionLeft.Version.Version.HasForge Then ModLoaders.Add(CompModLoaderType.Forge)
If PageVersionLeft.Version.Version.HasNeoForge Then ModLoaders.Add(CompModLoaderType.NeoForge)
If PageVersionLeft.Version.Version.HasFabric Then ModLoaders.Add(CompModLoaderType.Fabric)
If PageVersionLeft.Version.Version.HasLiteLoader Then ModLoaders.Add(CompModLoaderType.LiteLoader)
If PageInstanceLeft.Instance.Version.HasForge Then ModLoaders.Add(CompModLoaderType.Forge)
If PageInstanceLeft.Instance.Version.HasNeoForge Then ModLoaders.Add(CompModLoaderType.NeoForge)
If PageInstanceLeft.Instance.Version.HasFabric Then ModLoaders.Add(CompModLoaderType.Fabric)
If PageInstanceLeft.Instance.Version.HasLiteLoader Then ModLoaders.Add(CompModLoaderType.LiteLoader)
If Not ModLoaders.Any() Then ModLoaders.AddRange({CompModLoaderType.Forge, CompModLoaderType.NeoForge, CompModLoaderType.Fabric, CompModLoaderType.LiteLoader, CompModLoaderType.Quilt})
Return ModLoaders
End Function
#If DEBUG Then
''' <summary>
''' 检查 Mod 列表中存在的错误，返回错误信息的集合。
''' </summary>
Public Function McModCheck(Version As McVersion, Mods As List(Of McMod)) As List(Of String)
Dim Result As New List(Of String)
'令所有 Mod 进行基础检查，并归纳需要检查的 Mod
Dim CurrentModList As New List(Of McMod)
For Each ModEntity In Mods
If Not ModEntity.IsFileAvailable Then
Result.Add("无法读取的 Mod 文件。" & vbCrLf & " - " & ModEntity.Path)
Continue For
End If
If ModEntity.State = McMod.McModState.Fine AndAlso ModEntity.ModId IsNot Nothing Then CurrentModList.Add(ModEntity)
Next
'添加默认依赖
Dim CurrentDependencies As New Dictionary(Of String, String()) '{DependencyVersion, Path}
If Version.State = McVersionState.Forge Then CurrentDependencies.Add("forge", {Version.Version.ForgeVersion, "Forge"})
CurrentDependencies.Add("minecraft", {Version.Version.McName, "Minecraft"})
'检查重复的 Mod，并添加对应的依赖
For Each ModEntity In CurrentModList
For Each PossibleModId In ModEntity.PossibleModId
If CurrentDependencies.ContainsKey(PossibleModId) Then
If CurrentDependencies(PossibleModId)(2) = 1 Then
Result.Add("重复添加了相同的 Mod，请尝试删除其中一个（ModID：" & PossibleModId & "）。" & vbCrLf &
" - " & ModEntity.FileName & vbCrLf &
" - " & CurrentDependencies(PossibleModId)(1))
Else
Log("[Minecraft] 由于可能有多个 ModID，跳过疑似的重复项（ModID：" & PossibleModId & "）。" & vbCrLf &
" - " & ModEntity.FileName & vbCrLf &
" - " & CurrentDependencies(PossibleModId)(1), LogLevel.Developer)
End If
Else
CurrentDependencies.Add(PossibleModId, {ModEntity.Version, ModEntity.FileName, ModEntity.PossibleModId.Count})
End If
Next
Next
'检查依赖
For Each ModEntity In CurrentModList
Try
For Each Dependency In ModEntity.Dependencies
Dim ReqId As String = Dependency.Key
If ReqId.Count < 2 Then Continue For '确保正常
If ReqId = ModEntity.ModId Then Continue For '跳过自体引用
If ReqId = "forgemultipartcbe" Then Continue For '跳过莫名其妙的引用
If Dependency.Value IsNot Nothing Then
'获取分段后的详细版本信息
Dim ReqVersion As String = Dependency.Value
Dim ReqVersionHeadCanEqual As Boolean = ReqVersion.StartsWithF("[")
Dim ReqVersionTailCanEqual As Boolean = ReqVersion.EndsWithF("]")
Dim ReqVersionHead As String
Dim ReqVersionTail As String
If ReqVersion.Contains(",") Then
ReqVersionHead = ReqVersion.Split(",")(0).Trim("([ ".ToCharArray())
ReqVersionTail = ReqVersion.Split(",")(1).Trim("]) ".ToCharArray())
Else
ReqVersionHead = ReqVersion.Trim("([]) ".ToCharArray())
ReqVersionTail = ReqVersionHead
If ReqId = "minecraft" AndAlso ReqVersionHead.Split(".").Count = 2 Then
ReqVersionTail = ReqVersionHead.Split(".")(0) & "." & (Val(ReqVersionHead.Split(".")(1)) + 1)
ReqVersionTailCanEqual = False
End If
End If
If ReqVersionHead.StartsWithF("1.") AndAlso ReqVersionHead.Contains("-") Then ReqVersionHead = ReqVersionHead.Substring(ReqVersionHead.LastIndexOfF("-") + 1)
If ReqVersionTail.StartsWithF("1.") AndAlso ReqVersionTail.Contains("-") Then ReqVersionTail = ReqVersionTail.Substring(ReqVersionTail.LastIndexOfF("-") + 1)
'获取报错描述文本
Dim VersionRequire As String
If ReqVersionHead = ReqVersionTail Then
VersionRequire = "应为 " & ReqVersionHead
ElseIf ReqVersionHead.Contains(".") AndAlso ReqVersionTail.Contains(".") Then
VersionRequire = $"应为 {ReqVersionHead} 至 {ReqVersionTail}"
ElseIf ReqVersionHead.Contains(".") Then
If ReqVersionHeadCanEqual Then
VersionRequire = "最低应为 " & ReqVersionHead
Else
VersionRequire = "应高于 " & ReqVersionHead
End If
ElseIf ReqVersionTail.Contains(".") Then
If ReqVersionTailCanEqual Then
VersionRequire = "最高应为 " & ReqVersionHead
Else
VersionRequire = "应低于 " & ReqVersionHead
End If
Else
VersionRequire = ""
End If
'检查前置 Mod 是否存在，并获取其版本
If Not CurrentDependencies.ContainsKey(ReqId) Then
Result.Add($"缺少前置 Mod：{ReqId}{If(VersionRequire = "", "", "，其版本" & VersionRequire)}。{vbCrLf} - {ModEntity.FileName}")
Continue For
End If
Dim CurrentVersion As String = If(CurrentDependencies(ReqId)(0), "0.0")
If CurrentVersion.StartsWithF("1.") AndAlso CurrentVersion.Contains("-") Then CurrentVersion = CurrentVersion.Substring(CurrentVersion.LastIndexOfF("-") + 1)
'对比前置 Mod 头部版本
If ReqVersionHead.Contains(".") Then
If VersionSortInteger(ReqVersionHead, CurrentVersion) > If(ReqVersionHeadCanEqual, 0, -1) Then
Result.Add(ReqId.Substring(0, 1).ToUpper & ReqId.Substring(1) & " 版本过低，其版本" & VersionRequire & "，而当前版本为 " & CurrentVersion & "。" & vbCrLf &
" - " & ModEntity.FileName & If(ReqId <> "minecraft" AndAlso ReqId <> "forge", $"{vbCrLf} - 前置：{CurrentDependencies(ReqId)(1)}", ""))
Continue For
End If
End If
'对比前置 Mod 尾部版本
If ReqVersionTail.Contains(".") Then
If VersionSortInteger(CurrentVersion, ReqVersionTail) > If(ReqVersionTailCanEqual, 0, -1) Then
Result.Add(ReqId.Substring(0, 1).ToUpper & ReqId.Substring(1) & " 版本过高，其版本" & VersionRequire & "，而当前版本为 " & CurrentVersion & "。" & vbCrLf &
" - " & ModEntity.FileName & If(ReqId <> "minecraft" AndAlso ReqId <> "forge", $"{vbCrLf} - 前置：{CurrentDependencies(ReqId)(1)}", ""))
Continue For
End If
End If
Else
If Not CurrentDependencies.ContainsKey(Dependency.Key) Then
Result.Add($"缺少前置 Mod：{Dependency.Key}。{vbCrLf} - {ModEntity.FileName}")
Continue For
End If
End If
Next
Catch ex As Exception
Result.Add($"检查 Mod 时出错：{ex.GetBrief()}{vbCrLf} - {ModEntity.FileName}")
Log(ex, "检查 Mod 时出错")
End Try
Next
If Not Result.Any() Then
Log("[Minecraft] Mod 检查未发现异常")
Else
Log($"[Minecraft] Mod 检查异常结果：{vbCrLf}{Join(Result, vbCrLf)}")
End If
Return Result
End Function
#End If
End Module
Plain Craft Launcher 2/Modules/Minecraft/ModModpack.vb
+74 -75
View File
@@ -24,13 +24,13 @@ Public Module ModModpack
''' 必须在工作线程执行。
''' </summary>
''' <exception cref="CancelledException" />
Public Function ModpackInstall(File As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
Public Function ModpackInstall(File As String, Optional InstanceName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
Log("[ModPack] 整合包安装请求：" & If(File, "null"))
Dim Archive As ZipArchive = Nothing
Dim ArchiveBaseFolder As String = ""
Try
'字符校验
Dim TargetFolder As String = $"{PathMcFolder}versions\{VersionName}\"
Dim TargetFolder As String = $"{McFolderSelected}versions\{InstanceName}\"
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("游戏路径中不能含有感叹号或分号：" & TargetFolder, HintType.Red) : Throw New CancelledException
'获取整合包种类与关键 Json
Dim PackType As Integer = -1
@@ -84,7 +84,7 @@ Public Module ModModpack
Select Case PackType
Case 0
Log("[ModPack] 整合包种类：CurseForge")
Return InstallPackCurseForge(File, Archive, ArchiveBaseFolder, VersionName, Logo)
Return InstallPackCurseForge(File, Archive, ArchiveBaseFolder, InstanceName, Logo)
Case 1
Log("[ModPack] 整合包种类：HMCL")
Return InstallPackHMCL(File, Archive, ArchiveBaseFolder)
@@ -93,10 +93,10 @@ Public Module ModModpack
Return InstallPackMMC(File, Archive, ArchiveBaseFolder)
Case 3
Log("[ModPack] 整合包种类：MCBBS")
Return InstallPackMCBBS(File, Archive, ArchiveBaseFolder, VersionName)
Return InstallPackMCBBS(File, Archive, ArchiveBaseFolder, InstanceName)
Case 4
Log("[ModPack] 整合包种类：Modrinth")
Return InstallPackModrinth(File, Archive, ArchiveBaseFolder, VersionName, Logo)
Return InstallPackModrinth(File, Archive, ArchiveBaseFolder, InstanceName, Logo)
Case 9
Log("[ModPack] 整合包种类：带启动器的压缩包")
Return InstallPackLauncherPack(File, Archive, ArchiveBaseFolder)
@@ -180,7 +180,7 @@ Retry:
'CurseForge
Private Function InstallPackCurseForge(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String,
Optional VersionName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
Optional InstanceName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
'读取 Json 文件
Dim Json As JObject
@@ -192,12 +192,12 @@ Retry:
If Json("minecraft") Is Nothing OrElse Json("minecraft")("version") Is Nothing Then Throw New Exception("CurseForge 整合包未提供 Minecraft 版本信息")
'获取版本名
If VersionName Is Nothing Then
VersionName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(VersionName) <> "" Then VersionName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
If InstanceName Is Nothing Then
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
End If
'获取 Mod API 版本信息
@@ -234,7 +234,7 @@ Retry:
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & If(OverrideHome = "." OrElse OverrideHome = "./", "", OverrideHome), '#5613
$"{PathMcFolder}versions\{VersionName}",
$"{McFolderSelected}versions\{InstanceName}",
Task, 0.4)
End Sub) With {
.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
@@ -292,7 +292,7 @@ Retry:
Dim File As New CompFile(ModJson, Type)
If Not File.Available Then Continue For
'实际的添加
FileList.Add(Id, File.ToNetFile($"{PathMcFolder}versions\{VersionName}\{TargetFolder}\"))
FileList.Add(Id, File.ToNetFile($"{McFolderSelected}versions\{InstanceName}\{TargetFolder}\"))
Task.Progress += 1 / (1 + ModList.Count)
Next
Task.Output = FileList.Values.ToList
@@ -306,8 +306,8 @@ Retry:
'构造加载器
Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName,
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
.NewInstanceName = InstanceName,
.VersionFolder = $"{McFolderSelected}versions\{InstanceName}\",
.MinecraftName = Json("minecraft")("version").ToString,
.ForgeVersion = ForgeVersion,
.NeoForgeVersion = NeoForgeVersion,
@@ -321,7 +321,7 @@ Retry:
Loaders.Add(New LoaderTask(Of String, String)("最终整理文件",
Sub(Task As LoaderTask(Of String, String))
'设置图标
Dim VersionFolder As String = $"{PathMcFolder}versions\{VersionName}\"
Dim VersionFolder As String = $"{McFolderSelected}versions\{InstanceName}\"
If Logo IsNot Nothing AndAlso File.Exists(Logo) Then
File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
@@ -342,7 +342,7 @@ Retry:
End Sub) With {.ProgressWeight = 0.1, .Show = False})
'重复任务检查
Dim LoaderName As String = "CurseForge 整合包安装：" & VersionName & " "
Dim LoaderName As String = "CurseForge 整合包安装：" & InstanceName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中！", HintType.Red)
Throw New CancelledException
@@ -350,7 +350,7 @@ Retry:
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
Loader.Start(Request.TargetVersionFolder)
Loader.Start(Request.VersionFolder)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
@@ -358,7 +358,7 @@ Retry:
End Function
'Modrinth
Private Function InstallPackModrinth(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing) As LoaderCombo(Of String)
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)
'读取 Json 文件
Dim Json As JObject
@@ -392,12 +392,12 @@ Retry:
End Select
Next
'获取版本名
If VersionName Is Nothing Then
VersionName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(VersionName) <> "" Then VersionName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
If InstanceName Is Nothing Then
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
End If
'解压
Dim InstallTemp As String = RequestTaskTempFolder()
@@ -407,11 +407,11 @@ Retry:
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.5)
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "overrides",
PathMcFolder & "versions\" & VersionName,
McFolderSelected & "versions\" & InstanceName,
Task, 0.4)
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "client-overrides",
PathMcFolder & "versions\" & VersionName,
McFolderSelected & "versions\" & InstanceName,
Task, 0.1)
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'获取下载文件列表
@@ -433,8 +433,8 @@ Retry:
Dim Urls = File("downloads").SelectMany(Function(t) CompFile.HandleCurseForgeDownloadUrls(t.ToString)).ToList
Urls.AddRange(Urls.Select(Function(u) DlSourceModGet(u)).ToList)
Urls = Urls.Distinct.ToList()
Dim TargetPath As String = $"{PathMcFolder}versions\{VersionName}\{File("path")}"
If Not IO.Path.GetFullPath(TargetPath).StartsWithF($"{PathMcFolder}versions\{VersionName}\", True) Then
Dim TargetPath As String = $"{McFolderSelected}versions\{InstanceName}\{File("path")}"
If Not IO.Path.GetFullPath(TargetPath).StartsWithF($"{McFolderSelected}versions\{InstanceName}\", True) Then
MyMsgBox($"整合包的文件路径超出了版本文件夹，请向整合包作者反馈此问题！" & vbCrLf & "错误的文件：" & TargetPath, "文件路径校验失败", IsWarn:=True)
Throw New CancelledException
End If
@@ -447,8 +447,8 @@ Retry:
'构造加载器
Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName,
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
.NewInstanceName = InstanceName,
.VersionFolder = $"{McFolderSelected}versions\{InstanceName}\",
.MinecraftName = MinecraftVersion,
.ForgeVersion = ForgeVersion,
.NeoForgeVersion = NeoForgeVersion,
@@ -462,7 +462,7 @@ Retry:
Loaders.Add(New LoaderTask(Of String, String)("最终整理文件",
Sub(Task As LoaderTask(Of String, String))
'设置图标
Dim VersionFolder As String = $"{PathMcFolder}versions\{VersionName}\"
Dim VersionFolder As String = $"{McFolderSelected}versions\{InstanceName}\"
If Logo IsNot Nothing AndAlso File.Exists(Logo) Then
File.Copy(Logo, VersionFolder & "PCL\Logo.png", True)
WriteIni(VersionFolder & "PCL\Setup.ini", "Logo", "PCL\Logo.png")
@@ -483,7 +483,7 @@ Retry:
End Sub) With {.ProgressWeight = 0.1, .Show = False})
'重复任务检查
Dim LoaderName As String = $"Modrinth 整合包安装：{VersionName} "
Dim LoaderName As String = $"Modrinth 整合包安装：{InstanceName} "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中！", HintType.Red)
Throw New CancelledException
@@ -491,7 +491,7 @@ Retry:
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
Loader.Start(Request.TargetVersionFolder)
Loader.Start(Request.VersionFolder)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
@@ -508,11 +508,11 @@ Retry:
Throw New Exception("HMCL 整合包安装信息存在问题", ex)
End Try
'获取版本名
Dim VersionName As String = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(VersionName) <> "" Then VersionName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
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
'解压
Dim InstallTemp As String = RequestTaskTempFolder()
Dim InstallLoaders As New List(Of LoaderBase)
@@ -521,14 +521,14 @@ Retry:
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "minecraft",
PathMcFolder & "versions\" & VersionName,
McFolderSelected & "versions\" & InstanceName,
Task, 0.4)
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'构造游戏本体安装加载器
If Json("gameVersion") Is Nothing Then Throw New Exception("该 HMCL 整合包未提供游戏版本信息，无法安装！")
Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName,
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
.NewInstanceName = InstanceName,
.VersionFolder = $"{McFolderSelected}versions\{InstanceName}\",
.MinecraftName = Json("gameVersion").ToString
}
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request)
@@ -538,14 +538,14 @@ Retry:
New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)}
}
'重复任务检查
Dim LoaderName As String = "HMCL 整合包安装：" & VersionName & " "
Dim LoaderName As String = "HMCL 整合包安装：" & InstanceName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中！", HintType.Red)
Throw New CancelledException
End If
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
Loader.Start(Request.TargetVersionFolder)
Loader.Start(Request.VersionFolder)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
@@ -563,21 +563,21 @@ Retry:
Throw New Exception("MMC 整合包安装信息存在问题", ex)
End Try
'获取版本名
Dim VersionName As String = If(RegexSeek(PackInstance, "(?<=\nname\=)[^\n]+"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(VersionName) <> "" Then VersionName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
Dim InstanceName As String = If(RegexSeek(PackInstance, "(?<=\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
'解压
Dim InstallTemp As String = RequestTaskTempFolder()
Dim SetupFile As String = $"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini"
Dim SetupFile As String = $"{McFolderSelected}versions\{InstanceName}\PCL\Setup.ini"
Dim InstallLoaders As New List(Of LoaderBase)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer))
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.55)
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & ".minecraft",
PathMcFolder & "versions\" & VersionName,
McFolderSelected & "versions\" & InstanceName,
Task, 0.4)
'读取 MMC 设置文件（#2655）
Try
@@ -616,7 +616,7 @@ Retry:
If Logo <> "" AndAlso File.Exists($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png") Then
WriteIni(SetupFile, "LogoCustom", True)
WriteIni(SetupFile, "Logo", "PCL\Logo.png")
CopyFile($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png", $"{PathMcFolder}versions\{VersionName}\PCL\Logo.png")
CopyFile($"{InstallTemp}{ArchiveBaseFolder}{Logo}.png", $"{McFolderSelected}versions\{InstanceName}\PCL\Logo.png")
Log($"[ModPack] 迁移 MultiMC 版本独立设置：版本图标（{Logo}.png）")
End If
'JVM 参数
@@ -638,7 +638,7 @@ Retry:
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
'构造版本安装请求
If PackJson("components") Is Nothing Then Throw New Exception("该 MMC 整合包未提供游戏版本信息，无法安装！")
Dim Request As New McInstallRequest With {.TargetVersionName = VersionName, .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\"}
Dim Request As New McInstallRequest With {.NewInstanceName = InstanceName, .VersionFolder = $"{McFolderSelected}versions\{InstanceName}\"}
For Each Component As JObject In PackJson("components")
If Not Component.ContainsKey("uid") Then Continue For
Select Case Component("uid").ToString
@@ -665,7 +665,7 @@ Retry:
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
'重复任务检查
Dim LoaderName As String = "MMC 整合包安装：" & VersionName & " "
Dim LoaderName As String = "MMC 整合包安装：" & InstanceName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中！", HintType.Red)
Throw New CancelledException
@@ -673,7 +673,7 @@ Retry:
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
Loader.Start(Request.TargetVersionFolder)
Loader.Start(Request.VersionFolder)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
@@ -682,7 +682,7 @@ Retry:
'MCBBS
Private Function InstallPackMCBBS(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String,
Optional VersionName As String = Nothing) As LoaderCombo(Of String)
Optional InstanceName As String = Nothing) As LoaderCombo(Of String)
'读取 Json 文件
Dim Json As JObject
Try
@@ -692,23 +692,23 @@ Retry:
Throw New Exception("MCBBS 整合包安装信息存在问题", ex)
End Try
'获取版本名
If VersionName Is Nothing Then
VersionName = If(Json("name"), "")
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
If Validate.Validate(VersionName) <> "" Then VersionName = ""
If VersionName = "" Then VersionName = MyMsgBoxInput("输入版本名称", "", "", New ObjectModel.Collection(Of Validate) From {Validate})
If String.IsNullOrEmpty(VersionName) Then Throw New CancelledException
If InstanceName Is Nothing Then
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
End If
'解压
Dim InstallTemp As String = RequestTaskTempFolder()
Dim SetupFile As String = $"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini"
Dim SetupFile As String = $"{McFolderSelected}versions\{InstanceName}\PCL\Setup.ini"
Dim InstallLoaders As New List(Of LoaderBase)
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
Sub(Task As LoaderTask(Of String, Integer))
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
CopyOverrideDirectory(
InstallTemp & ArchiveBaseFolder & "overrides",
PathMcFolder & "versions\" & VersionName,
McFolderSelected & "versions\" & InstanceName,
Task, 0.4)
'JVM 参数
If Json("launchInfo") IsNot Nothing Then
@@ -729,8 +729,8 @@ Retry:
Throw New CancelledException
End If
Dim Request As New McInstallRequest With {
.TargetVersionName = VersionName,
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
.NewInstanceName = InstanceName,
.VersionFolder = $"{McFolderSelected}versions\{InstanceName}\",
.MinecraftName = Addons("game"),
.OptiFineVersion = If(Addons.ContainsKey("optifine"), Addons("optifine"), Nothing),
.ForgeVersion = If(Addons.ContainsKey("forge"), Addons("forge"), Nothing),
@@ -744,7 +744,7 @@ Retry:
Loaders.Add(New LoaderCombo(Of String)("游戏安装", MergeLoaders) With {.Show = False, .ProgressWeight = MergeLoaders.Sum(Function(l) l.ProgressWeight)})
'重复任务检查
Dim LoaderName As String = "MCBBS 整合包安装：" & VersionName & " "
Dim LoaderName As String = "MCBBS 整合包安装：" & InstanceName & " "
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
Hint("该整合包正在安装中！", HintType.Red)
Throw New CancelledException
@@ -753,7 +753,7 @@ Retry:
'启动
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
'If Archive IsNot Nothing Then Archive.Dispose() '解除占用，以免在加载器中触发 “正由另一进程使用，因此该进程无法访问此文件”
Loader.Start(Request.TargetVersionFolder)
Loader.Start(Request.VersionFolder)
LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh()
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
@@ -805,11 +805,11 @@ Retry:
End If
OpenExplorer(TargetFolder)
'加入文件夹列表
Dim VersionName As String = GetFolderNameFromPath(TargetFolder)
Dim InstanceName As String = GetFolderNameFromPath(TargetFolder)
Directory.CreateDirectory(TargetFolder & ".minecraft\")
PageSelectLeft.AddFolder(
TargetFolder & ".minecraft\" & ArchiveBaseFolder.Replace("/", "\").TrimStart("\"), '格式例如：包裹文件夹\.minecraft\（最短为空字符串）
VersionName, False)
InstanceName, False)
'调用 modpack 文件进行安装
Dim ModpackFile = Directory.GetFiles(TargetFolder, "modpack.*", SearchOption.AllDirectories).First
Log("[Modpack] 调用 modpack 文件继续安装：" & ModpackFile)
@@ -835,10 +835,9 @@ Retry:
Exit For
End If
Next
If Match Is Nothing Then Throw New Exception("未能找到适合的文件结构，这可能不是一个 MC 压缩包") '没有匹配
If Match Is Nothing Then Throw New Exception("文件结构不匹配，这可能不是 Minecraft 客户端压缩包？") '没有匹配
Dim ArchiveBaseFolder As String = Match.Value.Replace("/", "\").TrimStart("\") '格式例如：包裹文件夹\.minecraft\（最短为空字符串）
Dim VersionName As String = Match.Groups(1).Value
Log("[ModPack] 检测到压缩包的 .minecraft 根目录：" & ArchiveBaseFolder & "，命中的版本名：" & VersionName)
Log("[ModPack] 检测到压缩包的 .minecraft 根目录：" & ArchiveBaseFolder & "，命中的版本名：" & Match.Groups(1).Value)
'获取解压路径
MyMsgBox("接下来请选择一个空文件夹，它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
Dim TargetFolder As String = SelectFolder("选择安装目标（必须是一个空文件夹）")
@@ -853,7 +852,7 @@ Retry:
'加入文件夹列表
PageSelectLeft.AddFolder(TargetFolder & ArchiveBaseFolder, GetFolderNameFromPath(TargetFolder), False)
Thread.Sleep(400) '避免文件争用
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.VersionSelect))
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.InstanceSelect))
End Sub)
}) With {.OnStateChanged = AddressOf McInstallState}
Loader.Start(TargetFolder)
Plain Craft Launcher 2/Modules/Minecraft/ModWatcher.vb
+9 -9
View File
@@ -58,13 +58,13 @@
'初始化
Public GameProcess As Process
Public Version As McVersion
Public Instance As McInstance
Private WindowTitle As String = ""
Private PID As Integer
Public Loader As LoaderTask(Of Process, Integer)
Public Sub New(Loader As LoaderTask(Of Process, Integer), Version As McVersion, WindowTitle As String)
Public Sub New(Loader As LoaderTask(Of Process, Integer), Instance As McInstance, WindowTitle As String)
Me.Loader = Loader
Me.Version = Version
Me.Instance = Instance
Me.WindowTitle = WindowTitle
Me.PID = Loader.Input.Id
WatcherLog("开始 Minecraft 日志监控")
@@ -97,7 +97,7 @@
'设置窗口标题
For i = 1 To 3
If IsWindowFinished AndAlso IsWindowAppeared AndAlso WindowTitle <> "" AndAlso State = MinecraftState.Running AndAlso Not GameProcess.HasExited Then
Dim RealTitle As String = WindowTitle.Replace("{date}", Date.Now.ToString("yyyy/M/d")).Replace("{time}", Date.Now.ToString("HH:mm:ss"))
Dim RealTitle As String = WindowTitle.Replace("{date}", Date.Now.ToString("yyyy'/'M'/'d")).Replace("{time}", Date.Now.ToString("HH':'mm':'ss"))
SetWindowText(WindowHandle, RealTitle.ToCharArray)
End If
Thread.Sleep(64)
@@ -164,7 +164,7 @@
'窗口未出现
WatcherLog("Minecraft 尚未加载完成，可能已崩溃")
Crashed()
ElseIf GameProcess.ExitCode <> 0 AndAlso State = MinecraftState.Running AndAlso Version.ReleaseTime.Year >= 2012 Then
ElseIf GameProcess.ExitCode <> 0 AndAlso State = MinecraftState.Running AndAlso Instance.ReleaseTime.Year >= 2012 Then
'返回值不为 0 且未结束
WatcherLog("Minecraft 返回值异常，可能已崩溃")
Crashed()
@@ -356,12 +356,12 @@
Try
Thread.Sleep(2000)
WatcherLog("崩溃分析开始")
Dim Analyzer As New CrashAnalyzer(Version)
Analyzer.Collect(Version.PathIndie, LatestLog.ToList)
Dim Analyzer As New CrashAnalyzer(Instance)
Analyzer.Collect(Instance.PathIndie, LatestLog.ToList)
Analyzer.Prepare()
Analyzer.Analyze(Version)
Analyzer.Analyze()
Analyzer.Output(False, New List(Of String) From
{Version.Path & Version.Name & ".json", Path & "PCL\Log1.txt", Path & "PCL\LatestLaunch.bat"})
{Instance.PathVersion & Instance.Name & ".json", Path & "PCL\Log1.txt", Path & "PCL\LatestLaunch.bat"})
Catch ex As Exception
Log(ex, "崩溃分析失败", LogLevel.Feedback)
End Try