Merge branch 'Hex-Dragon:main' into main
This commit is contained in:
@@ -247,7 +247,13 @@
|
||||
Website = Data("links")("websiteUrl").ToString.TrimEnd("/")
|
||||
LastUpdate = Data("dateReleased") '#1194
|
||||
DownloadCount = Data("downloadCount")
|
||||
If Data("logo").Count > 0 Then LogoUrl = Data("logo")("thumbnailUrl")
|
||||
If Data("logo").Count > 0 Then
|
||||
If Data("logo")("thumbnailUrl") Is Nothing OrElse Data("logo")("thumbnailUrl") = "" Then
|
||||
LogoUrl = Data("logo")("url")
|
||||
Else
|
||||
LogoUrl = Data("logo")("thumbnailUrl")
|
||||
End If
|
||||
End If
|
||||
'FileIndexes / GameVersions / ModLoaders
|
||||
ModLoaders = New List(Of CompModLoaderType)
|
||||
Dim Files As New List(Of KeyValuePair(Of Integer, List(Of String))) 'FileId, GameVersions
|
||||
@@ -265,7 +271,7 @@
|
||||
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).Before("-")))).Where(Function(v) v > 0).
|
||||
Select(Function(v) CInt(Val(v.Split(".")(1).BeforeFirst("-")))).Where(Function(v) v > 0).
|
||||
Distinct.OrderByDescending(Function(v) v).ToList
|
||||
ModLoaders = ModLoaders.Distinct.OrderBy(Of Integer)(Function(t) t).ToList
|
||||
'Type
|
||||
@@ -278,7 +284,8 @@
|
||||
End If
|
||||
'Tags
|
||||
Tags = New List(Of String)
|
||||
For Each Category In Data("categories").Select(Of Integer)(Function(t) t("id")).Distinct.OrderByDescending(Function(c) c)
|
||||
For Each Category In If(Data("categories"), New JArray). '镜像源 API 可能丢失此字段:https://github.com/Hex-Dragon/PCL2/issues/4267#issuecomment-2254590831
|
||||
Select(Of Integer)(Function(t) t("id")).Distinct.OrderByDescending(Function(c) c)
|
||||
Select Case Category
|
||||
'Mod
|
||||
Case 406 : Tags.Add("世界元素")
|
||||
@@ -342,7 +349,7 @@
|
||||
'搜索结果的键为 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).Before("-"))).Where(Function(v) v > 0).
|
||||
Select(Of Integer)(Function(v) Val(v.Split(".")(1).BeforeFirst("-"))).Where(Function(v) v > 0).
|
||||
Distinct.OrderByDescending(Function(v) v).ToList
|
||||
'Type
|
||||
Select Case Data("project_type").ToString
|
||||
@@ -385,9 +392,9 @@
|
||||
Case "technology" : Tags.Add("科技")
|
||||
Case "magic" : Tags.Add("魔法")
|
||||
Case "adventure" : Tags.Add("冒险")
|
||||
Case "kitchen-sink" : Tags.Add("烹饪")
|
||||
Case "kitchen-sink" : Tags.Add("大杂烩")
|
||||
Case "lightweight" : Tags.Add("轻量")
|
||||
'FUTURE: Res
|
||||
'FUTURE: Res
|
||||
End Select
|
||||
Next
|
||||
If Not Tags.Any() Then Tags.Add("杂项")
|
||||
@@ -416,7 +423,7 @@
|
||||
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 LogoUrl IsNot Nothing Then Json("LogoUrl") = LogoUrl
|
||||
If Not String.IsNullOrEmpty(LogoUrl) Then Json("LogoUrl") = LogoUrl
|
||||
If GameVersions.Any Then Json("GameVersions") = New JArray(GameVersions)
|
||||
Json("CacheTime") = Date.Now '用于检查缓存时间
|
||||
Return Json
|
||||
@@ -428,7 +435,7 @@
|
||||
'获取版本描述
|
||||
Dim GameVersionDescription As String
|
||||
If GameVersions Is Nothing OrElse Not GameVersions.Any() Then
|
||||
GameVersionDescription = "未知"
|
||||
GameVersionDescription = "仅快照版本" '#5412
|
||||
Else
|
||||
Dim SpaVersions As New List(Of String)
|
||||
Dim IsOld As Boolean = False
|
||||
@@ -451,14 +458,14 @@
|
||||
If StartVersion = EndVersion Then
|
||||
SpaVersions.Add("1." & StartVersion)
|
||||
ElseIf McVersionHighest > -1 AndAlso StartVersion >= McVersionHighest Then
|
||||
If EndVersion <= 10 Then
|
||||
If EndVersion < 10 Then
|
||||
SpaVersions.Clear()
|
||||
SpaVersions.Add("全版本")
|
||||
Exit For
|
||||
Else
|
||||
SpaVersions.Add("1." & EndVersion & "+")
|
||||
End If
|
||||
ElseIf EndVersion <= 10 Then
|
||||
ElseIf EndVersion < 10 Then
|
||||
SpaVersions.Add("1." & StartVersion & "-")
|
||||
Exit For
|
||||
ElseIf StartVersion - EndVersion = 1 Then
|
||||
@@ -471,25 +478,32 @@
|
||||
End If
|
||||
'获取 Mod 加载器描述
|
||||
Dim ModLoaderDescriptionFull As String, ModLoaderDescriptionPart As String
|
||||
Select Case ModLoaders.Count
|
||||
Dim ModLoadersForDesc As New List(Of CompModLoaderType)(ModLoaders)
|
||||
If Setup.Get("ToolDownloadIgnoreQuilt") Then ModLoadersForDesc.Remove(CompModLoaderType.Quilt)
|
||||
Select Case ModLoadersForDesc.Count
|
||||
Case 0
|
||||
ModLoaderDescriptionFull = "未知"
|
||||
ModLoaderDescriptionPart = ""
|
||||
If ModLoaders.Count = 1 Then
|
||||
ModLoaderDescriptionFull = "仅 " & ModLoaders.Single.ToString
|
||||
ModLoaderDescriptionPart = ModLoaders.Single.ToString
|
||||
Else
|
||||
ModLoaderDescriptionFull = "未知"
|
||||
ModLoaderDescriptionPart = ""
|
||||
End If
|
||||
Case 1
|
||||
ModLoaderDescriptionFull = "仅 " & ModLoaders.Single.ToString
|
||||
ModLoaderDescriptionPart = ModLoaders.Single.ToString
|
||||
Case 2, 3
|
||||
If Setup.Get("ToolDownloadIgnoreQuilt") AndAlso
|
||||
ModLoaders.Contains(CompModLoaderType.Forge) AndAlso ModLoaders.Contains(CompModLoaderType.Fabric) Then
|
||||
ModLoaderDescriptionFull = "仅 " & ModLoadersForDesc.Single.ToString
|
||||
ModLoaderDescriptionPart = ModLoadersForDesc.Single.ToString
|
||||
Case Else
|
||||
Dim MaxVersion As Integer = If(GameVersions.Any, GameVersions.Max, 99)
|
||||
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
|
||||
ModLoaderDescriptionFull = "任意"
|
||||
ModLoaderDescriptionPart = ""
|
||||
Else
|
||||
ModLoaderDescriptionFull = ModLoaders.Join(" / ")
|
||||
ModLoaderDescriptionPart = ModLoaders.Join(" / ")
|
||||
ModLoaderDescriptionFull = ModLoadersForDesc.Join(" / ")
|
||||
ModLoaderDescriptionPart = ModLoadersForDesc.Join(" / ")
|
||||
End If
|
||||
Case Else
|
||||
ModLoaderDescriptionFull = "任意"
|
||||
ModLoaderDescriptionPart = ""
|
||||
End Select
|
||||
'实例化 UI
|
||||
Dim NewItem As New MyCompItem With {.Tag = Me, .Logo = GetControlLogo()}
|
||||
@@ -535,7 +549,7 @@
|
||||
Return NewItem
|
||||
End Function
|
||||
Public Function GetControlLogo() As String
|
||||
If LogoUrl Is Nothing Then
|
||||
If String.IsNullOrEmpty(LogoUrl) Then
|
||||
Return PathImage & "Icons/NoIcon.png"
|
||||
Else
|
||||
Return LogoUrl
|
||||
@@ -576,9 +590,9 @@
|
||||
'有中文翻译
|
||||
'尝试将文本分为三段:Title (EnglishName) - Suffix
|
||||
'检查时注意 Carpet:它没有中文译名,但有 Suffix
|
||||
Title = TranslatedName.Before(" (").Before(" - ")
|
||||
Title = TranslatedName.BeforeFirst(" (").BeforeFirst(" - ")
|
||||
Dim Suffix As String = ""
|
||||
If TranslatedName.After(")").Contains(" - ") Then Suffix = TranslatedName.After(")").After(" - ")
|
||||
If TranslatedName.AfterLast(")").Contains(" - ") Then Suffix = TranslatedName.AfterLast(")").AfterLast(" - ")
|
||||
Dim EnglishName As String = TranslatedName
|
||||
If Suffix <> "" Then EnglishName = EnglishName.Replace(" - " & Suffix, "")
|
||||
EnglishName = EnglishName.Replace(Title, "").Trim("("c, ")"c, " "c)
|
||||
@@ -751,7 +765,7 @@ NoSubtitle:
|
||||
Case CompType.ResourcePack
|
||||
'FUTURE: Res
|
||||
End Select
|
||||
Address += "&categoryId=" & If(Tag = "", "0", Tag.Before("/"))
|
||||
Address += "&categoryId=" & If(Tag = "", "0", Tag.BeforeFirst("/"))
|
||||
If ModLoader <> CompModLoaderType.Any Then Address += "&modLoaderType=" & CType(ModLoader, Integer)
|
||||
If Not String.IsNullOrEmpty(GameVersion) Then Address += "&gameVersion=" & GameVersion
|
||||
If Not String.IsNullOrEmpty(SearchText) Then Address += "&searchFilter=" & Net.WebUtility.UrlEncode(SearchText)
|
||||
@@ -772,7 +786,7 @@ NoSubtitle:
|
||||
'facets=[["categories:'game-mechanics'"],["categories:'forge'"],["versions:1.19.3"],["project_type:mod"]]
|
||||
Dim Facets As New List(Of String)
|
||||
Facets.Add($"[""project_type:{GetStringFromEnum(Type).ToLower}""]")
|
||||
If Not String.IsNullOrEmpty(Tag) Then Facets.Add($"[""categories:'{Tag.After("/")}'""]")
|
||||
If Not String.IsNullOrEmpty(Tag) Then Facets.Add($"[""categories:'{Tag.AfterLast("/")}'""]")
|
||||
If ModLoader <> CompModLoaderType.Any Then Facets.Add($"[""categories:'{GetStringFromEnum(ModLoader).ToLower}'""]")
|
||||
If Not String.IsNullOrEmpty(GameVersion) Then Facets.Add($"[""versions:'{GameVersion}'""]")
|
||||
Address += "&facets=[" & String.Join(",", Facets) & "]"
|
||||
@@ -880,7 +894,7 @@ NoSubtitle:
|
||||
If Not SearchResults(i).AbsoluteRight AndAlso i >= Math.Min(2, SearchResults.Count - 1) Then Exit For '把 3 个结果拼合以提高准确度
|
||||
If SearchResults(i).Item.CurseForgeSlug IsNot Nothing Then SearchResult += SearchResults(i).Item.CurseForgeSlug.Replace("-", " ").Replace("/", " ") & " "
|
||||
If SearchResults(i).Item.ModrinthSlug IsNot Nothing Then SearchResult += SearchResults(i).Item.ModrinthSlug.Replace("-", " ").Replace("/", " ") & " "
|
||||
SearchResult += SearchResults(i).Item.ChineseName.After(" (").TrimEnd(") ").Before(" - ").
|
||||
SearchResult += SearchResults(i).Item.ChineseName.AfterLast(" (").TrimEnd(") ").BeforeFirst(" - ").
|
||||
Replace(":", "").Replace("(", "").Replace(")", "").ToLower.Replace("/", " ") & " "
|
||||
Next
|
||||
Log("[Comp] 中文搜索原始关键词:" & SearchResult, LogLevel.Developer)
|
||||
@@ -943,30 +957,30 @@ Retry:
|
||||
Dim CurseForgeFailed As Boolean = False
|
||||
If CurseForgeUrl IsNot Nothing Then
|
||||
CurseForgeThread = RunInNewThread(
|
||||
Sub()
|
||||
Try
|
||||
'获取工程列表
|
||||
Log("[Comp] 开始从 CurseForge 获取工程列表:" & CurseForgeUrl)
|
||||
Dim RequestResult As JObject = NetGetCodeByRequestRetry(CurseForgeUrl, IsJson:=True, Encode:=Encoding.UTF8)
|
||||
Task.Progress += 0.2
|
||||
Dim ProjectList As New List(Of CompProject)
|
||||
For Each JsonEntry As JObject In RequestResult("data")
|
||||
ProjectList.Add(New CompProject(JsonEntry))
|
||||
Next
|
||||
'更新结果
|
||||
SyncLock ResultsLock
|
||||
RawResults.AddRange(ProjectList)
|
||||
End SyncLock
|
||||
Storage.CurseForgeOffset += ProjectList.Count
|
||||
Storage.CurseForgeTotal = RequestResult("pagination")("totalCount").ToObject(Of Integer)
|
||||
Log($"[Comp] 从 CurseForge 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.CurseForgeOffset} 个,共 {Storage.CurseForgeTotal} 个)")
|
||||
Catch ex As Exception
|
||||
Log(ex, "从 CurseForge 获取工程列表失败")
|
||||
Storage.CurseForgeTotal = Storage.CurseForgeOffset
|
||||
[Error] = ex
|
||||
CurseForgeFailed = True
|
||||
End Try
|
||||
End Sub, "CurseForge Project Request")
|
||||
Sub()
|
||||
Try
|
||||
'获取工程列表
|
||||
Log("[Comp] 开始从 CurseForge 获取工程列表:" & CurseForgeUrl)
|
||||
Dim RequestResult As JObject = DlModRequest(CurseForgeUrl, IsJson:=True)
|
||||
Task.Progress += 0.2
|
||||
Dim ProjectList As New List(Of CompProject)
|
||||
For Each JsonEntry As JObject In RequestResult("data")
|
||||
ProjectList.Add(New CompProject(JsonEntry))
|
||||
Next
|
||||
'更新结果
|
||||
SyncLock ResultsLock
|
||||
RawResults.AddRange(ProjectList)
|
||||
End SyncLock
|
||||
Storage.CurseForgeOffset += ProjectList.Count
|
||||
Storage.CurseForgeTotal = RequestResult("pagination")("totalCount").ToObject(Of Integer)
|
||||
Log($"[Comp] 从 CurseForge 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.CurseForgeOffset} 个,共 {Storage.CurseForgeTotal} 个)")
|
||||
Catch ex As Exception
|
||||
Log(ex, "从 CurseForge 获取工程列表失败")
|
||||
Storage.CurseForgeTotal = -1 'Storage.CurseForgeOffset
|
||||
[Error] = ex
|
||||
CurseForgeFailed = True
|
||||
End Try
|
||||
End Sub, "CurseForge Project Request")
|
||||
End If
|
||||
|
||||
'启动 Modrinth 线程
|
||||
@@ -974,32 +988,32 @@ Retry:
|
||||
Dim ModrinthFailed As Boolean = False
|
||||
If ModrinthUrl IsNot Nothing Then
|
||||
ModrinthThread = RunInNewThread(
|
||||
Sub()
|
||||
Try
|
||||
Log("[Comp] 开始从 Modrinth 获取工程列表:" & ModrinthUrl)
|
||||
Dim RequestResult As JObject = NetGetCodeByRequestRetry(ModrinthUrl, IsJson:=True, Encode:=Encoding.UTF8)
|
||||
Task.Progress += 0.2
|
||||
Dim ProjectList As New List(Of CompProject)
|
||||
For Each JsonEntry As JObject In RequestResult("hits")
|
||||
ProjectList.Add(New CompProject(JsonEntry))
|
||||
Sub()
|
||||
Try
|
||||
Log("[Comp] 开始从 Modrinth 获取工程列表:" & ModrinthUrl)
|
||||
Dim RequestResult As JObject = DlModRequest(ModrinthUrl, IsJson:=True)
|
||||
Task.Progress += 0.2
|
||||
Dim ProjectList As New List(Of CompProject)
|
||||
For Each JsonEntry As JObject In RequestResult("hits")
|
||||
ProjectList.Add(New CompProject(JsonEntry))
|
||||
Next
|
||||
'更新结果
|
||||
SyncLock ResultsLock
|
||||
For Each Project In ProjectList
|
||||
If Task.Input.Type = CompType.Mod AndAlso Not Project.ModLoaders.Any() Then Continue For '过滤插件(#2458)
|
||||
RawResults.Add(Project)
|
||||
Next
|
||||
'更新结果
|
||||
SyncLock ResultsLock
|
||||
For Each Project In ProjectList
|
||||
If Task.Input.Type = CompType.Mod AndAlso Not Project.ModLoaders.Any() Then Continue For '过滤插件(#2458)
|
||||
RawResults.Add(Project)
|
||||
Next
|
||||
End SyncLock
|
||||
Storage.ModrinthOffset += ProjectList.Count
|
||||
Storage.ModrinthTotal = RequestResult("total_hits").ToObject(Of Integer)
|
||||
Log($"[Comp] 从 Modrinth 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.ModrinthOffset} 个,共 {Storage.ModrinthTotal} 个)")
|
||||
Catch ex As Exception
|
||||
Log(ex, "从 Modrinth 获取工程列表失败")
|
||||
Storage.ModrinthTotal = Storage.ModrinthOffset
|
||||
[Error] = ex
|
||||
ModrinthFailed = True
|
||||
End Try
|
||||
End Sub, "Modrinth Project Request")
|
||||
End SyncLock
|
||||
Storage.ModrinthOffset += ProjectList.Count
|
||||
Storage.ModrinthTotal = RequestResult("total_hits").ToObject(Of Integer)
|
||||
Log($"[Comp] 从 Modrinth 获取到了 {ProjectList.Count} 个工程(已获取 {Storage.ModrinthOffset} 个,共 {Storage.ModrinthTotal} 个)")
|
||||
Catch ex As Exception
|
||||
Log(ex, "从 Modrinth 获取工程列表失败")
|
||||
Storage.ModrinthTotal = -1 'Storage.ModrinthOffset
|
||||
[Error] = ex
|
||||
ModrinthFailed = True
|
||||
End Try
|
||||
End Sub, "Modrinth Project Request")
|
||||
End If
|
||||
|
||||
'等待线程结束
|
||||
@@ -1021,7 +1035,7 @@ Retry:
|
||||
ElseIf Task.Input.Source = CompSourceType.Modrinth AndAlso Task.Input.Tag.EndsWithF("/") Then
|
||||
Throw New Exception("Modrinth 不兼容所选的类型")
|
||||
Else
|
||||
Throw New Exception("没有符合条件的结果")
|
||||
Throw New Exception("没有搜索结果")
|
||||
End If
|
||||
End If
|
||||
ElseIf [Error] IsNot Nothing Then
|
||||
@@ -1060,7 +1074,7 @@ Retry:
|
||||
|
||||
If RealResults.Count + Storage.Results.Count < Task.Input.TargetResultCount Then
|
||||
Log($"[Comp] 总结果数需求最少 {Task.Input.TargetResultCount} 个,仅获得了 {RealResults.Count + Storage.Results.Count} 个")
|
||||
If Task.Input.CanContinue Then
|
||||
If Task.Input.CanContinue AndAlso [Error] Is Nothing Then '如果有下载源失败则不再重试,这时候重试可能导致无限循环
|
||||
Log("[Comp] 将继续尝试加载下一页")
|
||||
GoTo Retry
|
||||
Else
|
||||
@@ -1076,7 +1090,7 @@ Retry:
|
||||
If String.IsNullOrEmpty(Task.Input.SearchText) Then
|
||||
'如果没有搜索文本,按下载量将结果排序
|
||||
For Each Result As CompProject In RealResults
|
||||
Scores.Add(Result, Result.DownloadCount * If(Result.FromCurseForge, 1, 30))
|
||||
Scores.Add(Result, Result.DownloadCount * If(Result.FromCurseForge, 1, 10))
|
||||
Next
|
||||
Else
|
||||
'如果有搜索文本,按关联度将结果排序
|
||||
@@ -1084,7 +1098,7 @@ Retry:
|
||||
Dim Entry As New List(Of SearchEntry(Of CompProject))
|
||||
For Each Result As CompProject In RealResults
|
||||
Scores.Add(Result, If(Result.WikiId > 0, 0.2, 0) +
|
||||
Math.Log10(Math.Max(Result.DownloadCount, 1) * If(Result.FromCurseForge, 1, 30)) / 9)
|
||||
Math.Log10(Math.Max(Result.DownloadCount, 1) * If(Result.FromCurseForge, 1, 10)) / 9)
|
||||
Entry.Add(New SearchEntry(Of CompProject) With {.Item = Result, .SearchSource = New List(Of KeyValuePair(Of String, Double)) From {
|
||||
New KeyValuePair(Of String, Double)(If(IsChineseSearch, Result.TranslatedName, Result.RawName), 1),
|
||||
New KeyValuePair(Of String, Double)(Result.Description, 0.05)}})
|
||||
@@ -1149,7 +1163,7 @@ Retry:
|
||||
''' </summary>
|
||||
Public ReadOnly ModLoaders As List(Of CompModLoaderType)
|
||||
''' <summary>
|
||||
''' 支持的游戏版本列表。类型包括:"1.18.5","1.18","1.18 快照","21w15a","未知版本"。
|
||||
''' 支持的游戏版本列表。类型包括:"1.18.5","1.18","1.18 预览版","21w15a","未知版本"。
|
||||
''' </summary>
|
||||
Public ReadOnly GameVersions As List(Of String)
|
||||
''' <summary>
|
||||
@@ -1253,7 +1267,9 @@ Retry:
|
||||
DownloadUrls = (New List(Of String) From {Url.Replace("-service.overwolf.wtf", ".forgecdn.net").Replace("://edge", "://media"),
|
||||
Url.Replace("-service.overwolf.wtf", ".forgecdn.net"),
|
||||
Url.Replace("://edge", "://media"),
|
||||
Url}).Distinct().ToList()
|
||||
Url}).Distinct.ToList '对脑残 CurseForge 的下载地址进行多种修正
|
||||
DownloadUrls.AddRange(DownloadUrls.Select(Function(u) DlSourceModGet(u)).ToList) '添加镜像源,这个写法是为了让镜像源排在后面
|
||||
DownloadUrls = DownloadUrls.Distinct.ToList '最终去重
|
||||
'Dependencies
|
||||
If Type = CompType.Mod Then
|
||||
RawDependencies = Data("dependencies").
|
||||
@@ -1263,7 +1279,7 @@ 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) v.StartsWithF("1.")).Select(Function(v) v.Replace("-snapshot", " 预览版")).ToList
|
||||
If GameVersions.Count > 1 Then
|
||||
GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList
|
||||
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)}
|
||||
@@ -1287,11 +1303,10 @@ Retry:
|
||||
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")
|
||||
'可能为空
|
||||
If CType(Data("files"), JArray).Any() Then
|
||||
If CType(Data("files"), JArray).Any() Then '可能为空
|
||||
Dim File As JToken = Data("files")(0)
|
||||
FileName = File("filename")
|
||||
DownloadUrls = New List(Of String) From {File("url")}
|
||||
DownloadUrls = New List(Of String) From {File("url"), DlSourceModGet(File("url"))}.Distinct.ToList '同时添加了镜像源
|
||||
Hash = File("hashes")("sha1")
|
||||
End If
|
||||
'Dependencies
|
||||
@@ -1305,7 +1320,7 @@ Retry:
|
||||
'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.")).
|
||||
Select(Function(v) If(v.Contains("-"), v.Before("-") & " 快照", If(v.StartsWithF("b1."), "远古版本", v))).ToList
|
||||
Select(Function(v) If(v.Contains("-"), v.BeforeFirst("-") & " 预览版", If(v.StartsWithF("b1."), "远古版本", v))).ToList
|
||||
If GameVersions.Count > 1 Then
|
||||
GameVersions = Sort(GameVersions, AddressOf VersionSortBoolean).ToList
|
||||
If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)}
|
||||
@@ -1354,28 +1369,26 @@ Retry:
|
||||
Optional BadDisplayName As Boolean = False) As MyListItem
|
||||
|
||||
'获取描述信息
|
||||
Dim Info As String = ""
|
||||
Dim Title As String = If(BadDisplayName, FileName, DisplayName)
|
||||
Dim Info As New List(Of String)
|
||||
If Title <> FileName.BeforeLast(".") Then Info.Add(FileName.BeforeLast("."))
|
||||
Select Case Type
|
||||
Case CompType.Mod
|
||||
Info += If(ModLoaders.Any,
|
||||
"适用于 " & Join(ModLoaders.Select(Function(m) GetStringFromEnum(m)).ToList, "/") & ",", "")
|
||||
Info += If(ModeDebug AndAlso Dependencies.Any, Dependencies.Count & " 个前置 Mod,", "")
|
||||
If Dependencies.Any Then Info.Add(Dependencies.Count & " 个前置 Mod")
|
||||
Case CompType.ModPack
|
||||
If GameVersions.All(Function(v) v.Contains("w")) Then
|
||||
Info += $"游戏版本 {Join(GameVersions, "、")},"
|
||||
End If
|
||||
If GameVersions.All(Function(v) v.Contains("w")) Then Info.Add($"游戏版本 {Join(GameVersions, "、")}")
|
||||
End Select
|
||||
If DownloadCount > 0 Then 'CurseForge 的下载次数经常错误地返回 0
|
||||
Info += If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次下载,", DownloadCount & " 次下载,")
|
||||
Info.Add("下载 " & If(DownloadCount > 100000, Math.Round(DownloadCount / 10000) & " 万次", DownloadCount & " 次"))
|
||||
End If
|
||||
Info += GetTimeSpanString(ReleaseDate - Date.Now, False) & "更新"
|
||||
Info += If(Status = CompFileStatus.Release, "", "," & StatusDescription)
|
||||
Info.Add("更新于 " & GetTimeSpanString(ReleaseDate - Date.Now, False))
|
||||
If Status <> CompFileStatus.Release Then Info.Add(StatusDescription)
|
||||
|
||||
'建立控件
|
||||
Dim NewItem As New MyListItem With {
|
||||
.Title = If(BadDisplayName, FileName, DisplayName),
|
||||
.Title = Title,
|
||||
.SnapsToDevicePixels = True, .Height = 42, .Type = MyListItem.CheckType.Clickable, .Tag = Me,
|
||||
.Info = Info
|
||||
.Info = Info.Join(",")
|
||||
}
|
||||
Select Case Status
|
||||
Case CompFileStatus.Release
|
||||
@@ -1414,54 +1427,52 @@ Retry:
|
||||
''' <summary>
|
||||
''' 已知文件信息的缓存。
|
||||
''' </summary>
|
||||
Private CompFilesCache As New Dictionary(Of String, List(Of CompFile))
|
||||
Public CompFilesCache As New Dictionary(Of String, List(Of CompFile))
|
||||
''' <summary>
|
||||
''' 获取某个工程下的全部文件列表。
|
||||
''' 必须在工作线程执行,失败会抛出异常。
|
||||
''' </summary>
|
||||
Public Function CompFilesGet(ProjectId As String, FromCurseForge As Boolean) As List(Of CompFile)
|
||||
'使用缓存
|
||||
If CompFilesCache.ContainsKey(ProjectId) Then Return CompFilesCache(ProjectId)
|
||||
'获取工程对象
|
||||
Dim TargetProject As CompProject
|
||||
If CompProjectCache.ContainsKey(ProjectId) Then '存在缓存
|
||||
TargetProject = CompProjectCache(ProjectId)
|
||||
ElseIf FromCurseForge Then 'CurseForge
|
||||
TargetProject = New CompProject(NetGetCodeByRequestRetry("https://api.curseforge.com/v1/mods/" & ProjectId, IsJson:=True, Encode:=Encoding.UTF8)("data"))
|
||||
TargetProject = New CompProject(DlModRequest("https://api.curseforge.com/v1/mods/" & ProjectId, IsJson:=True)("data"))
|
||||
Else 'Modrinth
|
||||
TargetProject = New CompProject(NetGetCodeByRequestRetry("https://api.modrinth.com/v2/project/" & ProjectId, IsJson:=True, Encode:=Encoding.UTF8))
|
||||
TargetProject = New CompProject(DlModRequest("https://api.modrinth.com/v2/project/" & ProjectId, IsJson:=True))
|
||||
End If
|
||||
'获取工程对象的文件列表
|
||||
Log("[Comp] 开始获取文件列表:" & ProjectId)
|
||||
Dim ResultJsonArray As JArray
|
||||
If FromCurseForge Then
|
||||
'CurseForge
|
||||
If TargetProject.Type = CompType.Mod Then 'Mod 使用每个版本最新的文件
|
||||
ResultJsonArray = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(TargetProject.CurseForgeFileIds, ",") & "]}", "application/json"))("data")
|
||||
Else '否则使用全部文件
|
||||
ResultJsonArray = NetGetCodeByRequestRetry($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=999", Accept:="application/json", IsJson:=True)("data")
|
||||
If Not CompFilesCache.ContainsKey(ProjectId) Then '有缓存也不能直接返回,这时候前置 Mod 可能没获取(#5173)
|
||||
Log("[Comp] 开始获取文件列表:" & ProjectId)
|
||||
Dim ResultJsonArray As JArray
|
||||
If FromCurseForge Then
|
||||
'CurseForge
|
||||
If TargetProject.Type = CompType.Mod Then 'Mod 使用每个版本最新的文件
|
||||
ResultJsonArray = GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(TargetProject.CurseForgeFileIds, ",") & "]}", "application/json"))("data")
|
||||
Else '否则使用全部文件
|
||||
ResultJsonArray = DlModRequest($"https://api.curseforge.com/v1/mods/{ProjectId}/files?pageSize=999", IsJson:=True)("data")
|
||||
End If
|
||||
Else
|
||||
'Modrinth
|
||||
ResultJsonArray = DlModRequest($"https://api.modrinth.com/v2/project/{ProjectId}/version", IsJson:=True)
|
||||
End If
|
||||
Else
|
||||
'Modrinth
|
||||
ResultJsonArray = NetGetCodeByRequestRetry($"https://api.modrinth.com/v2/project/{ProjectId}/version", Accept:="application/json", IsJson:=True)
|
||||
CompFilesCache(ProjectId) = ResultJsonArray.Select(Function(a) New CompFile(a, TargetProject.Type)).
|
||||
Where(Function(a) a.Available).ToList.Distinct(Function(a, b) a.Id = b.Id) 'CurseForge 可能会重复返回相同项(#1330)
|
||||
End If
|
||||
CompFilesCache(ProjectId) = ResultJsonArray.Select(Function(a) New CompFile(a, TargetProject.Type)).
|
||||
Where(Function(a) a.Available).ToList.Distinct(Function(a, b) a.Id = b.Id) 'CurseForge 可能会重复返回相同项(#1330)
|
||||
'获取前置 Mod 列表
|
||||
If TargetProject.Type <> CompType.Mod Then Return CompFilesCache(ProjectId)
|
||||
Dim Deps As List(Of String) = CompFilesCache(ProjectId).
|
||||
SelectMany(Function(f) f.RawDependencies).Distinct().ToList
|
||||
Dim Deps As List(Of String) = CompFilesCache(ProjectId).SelectMany(Function(f) f.RawDependencies).Distinct().ToList
|
||||
Dim UndoneDeps = Deps.Where(Function(f) Not CompProjectCache.ContainsKey(f)).ToList
|
||||
'获取前置 Mod 工程信息
|
||||
If UndoneDeps.Any Then
|
||||
Log($"[Comp] {ProjectId} 文件列表中还需要获取信息的前置 Mod:{Join(UndoneDeps, ",")}")
|
||||
Dim Projects As JArray
|
||||
If TargetProject.FromCurseForge Then
|
||||
Projects = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods",
|
||||
Projects = GetJson(DlModRequest("https://api.curseforge.com/v1/mods",
|
||||
"POST", "{""modIds"": [" & Join(UndoneDeps, ",") & "]}", "application/json"))("data")
|
||||
Else
|
||||
Projects = NetGetCodeByRequestRetry($"https://api.modrinth.com/v2/projects?ids=[""{Join(UndoneDeps, """,""")}""]",
|
||||
Accept:="application/json", IsJson:=True)
|
||||
Projects = DlModRequest($"https://api.modrinth.com/v2/projects?ids=[""{Join(UndoneDeps, """,""")}""]", IsJson:=True)
|
||||
End If
|
||||
For Each Project In Projects
|
||||
Dim NewProject As New CompProject(Project) '在 New 的时候就添加了缓存
|
||||
@@ -1469,10 +1480,10 @@ Retry:
|
||||
End If
|
||||
'更新前置 Mod 信息
|
||||
If Deps.Any Then
|
||||
For Each DepProject In Deps.Select(Function(id) CompProjectCache(id))
|
||||
For Each DepProject In Deps.Where(Function(id) CompProjectCache.ContainsKey(id)).Select(Function(id) CompProjectCache(id))
|
||||
For Each File In CompFilesCache(ProjectId)
|
||||
If File.RawDependencies.Contains(DepProject.Id) AndAlso DepProject.Id <> ProjectId Then
|
||||
File.Dependencies.Add(DepProject.Id)
|
||||
If Not File.Dependencies.Contains(DepProject.Id) Then File.Dependencies.Add(DepProject.Id)
|
||||
End If
|
||||
Next
|
||||
Next
|
||||
@@ -1489,10 +1500,11 @@ Retry:
|
||||
Dim Deps As List(Of String) = Files.SelectMany(Function(f) f.Dependencies).Distinct.ToList()
|
||||
Deps.Sort()
|
||||
If Not Deps.Any() Then Exit Sub
|
||||
Deps = Deps.Where(Function(dep)
|
||||
If Not CompProjectCache.ContainsKey(dep) Then Log($"[Comp] 未找到 ID {dep} 的前置 Mod 信息", LogLevel.Debug)
|
||||
Return CompProjectCache.ContainsKey(dep)
|
||||
End Function).ToList
|
||||
Deps = Deps.Where(
|
||||
Function(dep)
|
||||
If Not CompProjectCache.ContainsKey(dep) Then Log($"[Comp] 未找到 ID {dep} 的前置 Mod 信息", LogLevel.Debug)
|
||||
Return CompProjectCache.ContainsKey(dep)
|
||||
End Function).ToList
|
||||
'添加开头间隔
|
||||
Stack.Children.Add(New TextBlock With {.Text = "前置 Mod", .FontSize = 14, .HorizontalAlignment = HorizontalAlignment.Left, .Margin = New Thickness(6, 2, 0, 5)})
|
||||
'添加前置 Mod 列表
|
||||
|
||||
@@ -381,6 +381,7 @@ Extracted:
|
||||
没有可用的分析文件
|
||||
使用32位Java导致JVM无法分配足够多的内存
|
||||
Mod重复安装
|
||||
Mod互不兼容
|
||||
OptiFine与Forge不兼容
|
||||
Fabric报错
|
||||
Fabric报错并给出解决方案
|
||||
@@ -389,7 +390,7 @@ Extracted:
|
||||
版本Json中存在多个Forge
|
||||
Mod过多导致超出ID限制
|
||||
NightConfig的Bug
|
||||
ShadersMod与Optifine同时安装
|
||||
ShadersMod与OptiFine同时安装
|
||||
Forge安装不完整
|
||||
Mod需要Java11
|
||||
Mod缺少前置或MC版本错误
|
||||
@@ -413,7 +414,7 @@ Extracted:
|
||||
'崩溃日志
|
||||
If LogCrash IsNot Nothing Then
|
||||
Log("[Crash] 开始进行崩溃日志堆栈分析")
|
||||
Keywords.AddRange(AnalyzeStackKeyword(LogCrash.Before("System Details")))
|
||||
Keywords.AddRange(AnalyzeStackKeyword(LogCrash.BeforeFirst("System Details")))
|
||||
End If
|
||||
'Minecraft 日志
|
||||
If LogMc IsNot Nothing Then
|
||||
@@ -516,7 +517,7 @@ Done:
|
||||
If LogMc.Contains("java.lang.ClassNotFoundException: org.spongepowered.asm.launch.MixinTweaker") Then AppendReason(CrashReason.MixinBootstrap缺失)
|
||||
If LogMc.Contains("Couldn't set pixel format") Then AppendReason(CrashReason.显卡驱动不支持导致无法设置像素格式)
|
||||
If LogMc.Contains("java.lang.OutOfMemoryError") OrElse LogMc.Contains("an out of memory error") Then AppendReason(CrashReason.内存不足)
|
||||
If LogMc.Contains("java.lang.RuntimeException: Shaders Mod detected. Please remove it, OptiFine has built-in support for shaders.") Then AppendReason(CrashReason.ShadersMod与Optifine同时安装)
|
||||
If LogMc.Contains("java.lang.RuntimeException: Shaders Mod detected. Please remove it, OptiFine has built-in support for shaders.") Then AppendReason(CrashReason.ShadersMod与OptiFine同时安装)
|
||||
If LogMc.Contains("java.lang.NoSuchMethodError: sun.security.util.ManifestEntryVerifier") Then AppendReason(CrashReason.低版本Forge与高版本Java不兼容)
|
||||
If LogMc.Contains("1282: Invalid operation") Then AppendReason(CrashReason.光影或资源包导致OpenGL1282错误)
|
||||
If LogMc.Contains("signer information does not match signer information of other classes in the same package") Then AppendReason(CrashReason.文件或内容校验失败, If(RegexSeek(LogMc, "(?<=class "")[^']+(?=""'s signer information)"), "").TrimEnd(vbCrLf))
|
||||
@@ -525,6 +526,7 @@ Done:
|
||||
If LogMc.Contains("Unsupported class file major version") Then AppendReason(CrashReason.Java版本不兼容)
|
||||
If LogMc.Contains("com.electronwill.nightconfig.core.io.ParsingException: Not enough data available") Then AppendReason(CrashReason.NightConfig的Bug)
|
||||
If LogMc.Contains("Cannot find launch target fmlclient, unable to launch") Then AppendReason(CrashReason.Forge安装不完整)
|
||||
If LogMc.Contains("Invalid paths argument, contained no existing paths") AndAlso LogMc.Contains("libraries\net\minecraftforge\fmlcore") Then AppendReason(CrashReason.Forge安装不完整)
|
||||
If LogMc.Contains("Invalid module name: '' is not a Java identifier") Then AppendReason(CrashReason.Mod名称包含特殊字符)
|
||||
If LogMc.Contains("has been compiled by a more recent version of the Java Runtime (class file version 55.0), this version of the Java Runtime only recognizes class file versions up to") Then AppendReason(CrashReason.Mod需要Java11)
|
||||
If LogMc.Contains("java.lang.RuntimeException: java.lang.NoSuchMethodException: no such method: sun.misc.Unsafe.defineAnonymousClass(Class,byte[],Object[])Class/invokeVirtual") Then AppendReason(CrashReason.Mod需要Java11)
|
||||
@@ -540,12 +542,14 @@ Done:
|
||||
End If
|
||||
'确定的 Mod 导致崩溃
|
||||
If LogMc.Contains("Caught exception from ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(RegexSeek(LogMc, "(?<=Caught exception from )[^\n]+?")?.TrimEnd((vbCrLf & " ").ToCharArray)))
|
||||
'Mod 重复安装
|
||||
'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("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))
|
||||
'Mod 缺少前置
|
||||
If LogMc.Contains("Incompatible mods found!") Then '#5006
|
||||
AppendReason(CrashReason.Mod互不兼容, If(RegexSeek(LogMc, "(?<=Incompatible mods found![\s\S]+: )[\s\S]+?(?=\tat )"), ""))
|
||||
End If
|
||||
If LogMc.Contains("Missing or unsupported mandatory dependencies:") Then
|
||||
AppendReason(CrashReason.Mod缺少前置或MC版本错误,
|
||||
RegexSearch(LogMc, "(?<=Missing or unsupported mandatory dependencies:)([\n\r]+\t(.*))+", RegularExpressions.RegexOptions.IgnoreCase).
|
||||
@@ -591,40 +595,57 @@ Done:
|
||||
''' </summary>
|
||||
Private Sub AnalyzeCrit2()
|
||||
|
||||
'Mixin 分析
|
||||
Dim MixinAnalyze =
|
||||
Function(LogText As String) As Boolean
|
||||
Dim IsMixin As Boolean =
|
||||
LogText.Contains("Mixin prepare failed ") OrElse LogText.Contains("Mixin apply failed ") OrElse
|
||||
LogText.Contains("MixinApplyError") OrElse LogText.Contains("MixinTransformerError") OrElse
|
||||
LogText.Contains("mixin.injection.throwables.") OrElse LogText.Contains(".json] FAILED during )")
|
||||
If Not IsMixin Then Return False
|
||||
'Mod 名称匹配
|
||||
Dim ModName As String = RegexSeek(LogText, "(?<=from mod )[^.\/ ]+(?=\] from)")
|
||||
If ModName Is Nothing Then ModName = RegexSeek(LogText, "(?<=for mod )[^.\/ ]+(?= failed)")
|
||||
If ModName IsNot Nothing Then
|
||||
AppendReason(CrashReason.ModMixin失败, TryAnalyzeModName(ModName.TrimEnd((vbCrLf & " ").ToCharArray)))
|
||||
Return True
|
||||
End If
|
||||
'JSON 名称匹配
|
||||
For Each JsonName In RegexSearch(LogText, "(?<=^[^\t]+[ \[{(]{1})[^ \[{(]+\.[^ ]+(?=\.json)", RegularExpressions.RegexOptions.Multiline)
|
||||
AppendReason(CrashReason.ModMixin失败,
|
||||
TryAnalyzeModName(JsonName.Replace("mixins", "mixin").Replace(".mixin", "").Replace("mixin.", "")))
|
||||
Return True
|
||||
Next
|
||||
'没有明确匹配
|
||||
AppendReason(CrashReason.ModMixin失败)
|
||||
Return True
|
||||
End Function
|
||||
|
||||
'游戏日志分析
|
||||
If LogMc IsNot Nothing Then
|
||||
'Mixin 崩溃
|
||||
Dim IsMixin As Boolean = MixinAnalyze(LogMc)
|
||||
'常规信息
|
||||
If LogMc.Contains("An exception was thrown, the game will display an error screen and halt.") Then AppendReason(CrashReason.Forge报错, RegexSeek(LogMc, "(?<=the game will display an error screen and halt.[\n\r]+[^\n]+?Exception: )[\s\S]+?(?=\n\tat)")?.Trim(vbCrLf))
|
||||
If LogMc.Contains("A potential solution has been determined:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf))
|
||||
If LogMc.Contains("A potential solution has been determined, this may resolve your problem:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=A potential solution has been determined, this may resolve your problem:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf))
|
||||
If LogMc.Contains("确定了一种可能的解决方法,这样做可能会解决你的问题:") Then AppendReason(CrashReason.Fabric报错并给出解决方案, Join(RegexSearch(If(RegexSeek(LogMc, "(?<=确定了一种可能的解决方法,这样做可能会解决你的问题:\n)((\t)+ - [^\n]+\n)+"), ""), "(?<=(\t)+)[^\n]+"), vbLf))
|
||||
'Mixin 崩溃
|
||||
If LogMc.Contains("Mixin prepare failed ") OrElse LogMc.Contains("Mixin apply failed ") OrElse LogMc.Contains("MixinApplyError") OrElse
|
||||
LogMc.Contains("mixin.injection.throwables.") OrElse LogMc.Contains(".json] FAILED during )") Then
|
||||
Dim ModId As String = RegexSeek(LogMc, "(?<=in )[^./ ]+(?=.mixins.json.+failed injection check)")
|
||||
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=in mixins.)[^./ ]+(?=.json.+failed injection check)")
|
||||
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= failed .+ in )[^./ ]+(?=.mixins.json)")
|
||||
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= failed .+ in mixins.)[^./ ]+(?=.json)")
|
||||
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= failed mixins.)[^./ ]+(?=.json:)")
|
||||
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= in config \[)[^./ ]+(?=.mixins.json\] FAILED during )")
|
||||
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<= in config \[mixins.)[^./ ]+(?=.json\] FAILED during )")
|
||||
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=from mod )[^./ ]+(?=\] from)")
|
||||
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=for mod )[^./ ]+(?= failed)")
|
||||
'兜底名称判断
|
||||
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "[^./ \]]+(?=.mixins.json)")
|
||||
If ModId Is Nothing Then ModId = RegexSeek(LogMc, "(?<=mixins.)[^./ \]]+(?=.json)")
|
||||
AppendReason(CrashReason.ModMixin失败, TryAnalyzeModName(If(ModId, "").TrimEnd((vbCrLf & " ").ToCharArray)))
|
||||
Else
|
||||
'在 #3104 的情况下,这一句导致 OptiFabric 的 Mixin 失败错判为 Fabric Loader 加载失败
|
||||
If LogMc.Contains("due to errors, provided by ") Then AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=due to errors, provided by ')[^']+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
|
||||
If Not IsMixin AndAlso LogMc.Contains("due to errors, provided by ") Then '在 #3104 的情况下,这一句导致 OptiFabric 的 Mixin 失败错判为 Fabric Loader 加载失败
|
||||
AppendReason(CrashReason.确定Mod导致游戏崩溃, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=due to errors, provided by ')[^']+"), "").TrimEnd((vbCrLf & " ").ToCharArray)))
|
||||
End If
|
||||
End If
|
||||
|
||||
'崩溃报告分析
|
||||
If LogCrash IsNot Nothing Then
|
||||
'Mixin 崩溃
|
||||
MixinAnalyze(LogCrash)
|
||||
'常规信息
|
||||
If LogCrash.Contains("Suspected Mod") Then
|
||||
Dim Suspects = RegexSearch(LogCrash.Between("Suspected Mod", "Stacktrace"), "(?<=\n\t[^(\t]+\()[^)\n]+")
|
||||
If Suspects.Any Then AppendReason(CrashReason.怀疑Mod导致游戏崩溃, TryAnalyzeModName(Suspects))
|
||||
Dim SuspectsRaw As String = LogCrash.Between("Suspected Mod", "Stacktrace")
|
||||
If Not SuspectsRaw.StartsWithF("s: None") Then 'Suspected Mods: None
|
||||
Dim Suspects = RegexSearch(SuspectsRaw, "(?<=\n\t[^(\t]+\()[^)\n]+")
|
||||
If Suspects.Any Then AppendReason(CrashReason.怀疑Mod导致游戏崩溃, TryAnalyzeModName(Suspects))
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
|
||||
@@ -640,6 +661,8 @@ Done:
|
||||
If Not (LogMc.Contains("at net.") OrElse LogMc.Contains("INFO]")) AndAlso LogHs Is Nothing AndAlso LogCrash Is Nothing AndAlso LogMc.Length < 100 Then
|
||||
AppendReason(CrashReason.极短的程序输出, LogMc)
|
||||
End If
|
||||
'Mod 解析错误(常见于 Fabric 前置校验失败)
|
||||
If LogMc.Contains("Mod resolution failed") Then AppendReason(CrashReason.Mod加载器报错)
|
||||
'Mixin 失败可以导致大量 Mod 实例创建失败
|
||||
If LogMc.Contains("Failed to create mod instance.") Then AppendReason(CrashReason.Mod初始化失败, TryAnalyzeModName(If(RegexSeek(LogMc, "(?<=Failed to create mod instance. ModID: )[^,]+"), If(RegexSeek(LogMc, "(?<=Failed to create mod instance. ModId )[^\n]+(?= for )"), "")).TrimEnd(vbCrLf)))
|
||||
'注意:Fabric 的 Warnings were found! 不一定是崩溃原因,它可能是单纯的警报
|
||||
@@ -695,7 +718,7 @@ NextStack:
|
||||
If {"com", "org", "net", "asm", "fml", "mod", "jar", "sun", "lib", "map", "gui", "dev", "nio", "api", "dsi", "top", "mcp",
|
||||
"core", "init", "mods", "main", "file", "game", "load", "read", "done", "util", "tile", "item", "base", "oshi", "impl", "data", "pool", "task",
|
||||
"forge", "setup", "block", "model", "mixin", "event", "unimi", "netty", "world",
|
||||
"gitlab", "common", "server", "config", "loader", "launch", "entity", "assist", "client", "plugin", "modapi", "mojang", "shader", "events", "github", "recipe", "render", "packet", "events",
|
||||
"gitlab", "common", "server", "config", "mixins", "compat", "loader", "launch", "entity", "assist", "client", "plugin", "modapi", "mojang", "shader", "events", "github", "recipe", "render", "packet", "events",
|
||||
"preinit", "preload", "machine", "reflect", "channel", "general", "handler", "content", "systems", "modules", "service",
|
||||
"fastutil", "optifine", "internal", "platform", "override", "fabricmc", "neoforge",
|
||||
"injection", "listeners", "scheduler", "minecraft", "transformer", "transformers", "neoforged", "universal", "multipart", "minecraftforge", "blockentity", "spongepowered", "electronwill"
|
||||
@@ -738,13 +761,13 @@ NextStack:
|
||||
Details = Details.Replace("Fabric Mods", "¨")
|
||||
Log("[Crash] 崩溃报告中检测到 Fabric Mod 信息格式")
|
||||
End If
|
||||
Details = Details.After("¨")
|
||||
Details = Details.AfterLast("¨")
|
||||
|
||||
'[Forge] 获取所有包含 .jar 的行
|
||||
'[Fabric] 获取所有包含 Mod 信息的行
|
||||
Dim ModNameLines As New List(Of String)
|
||||
For Each Line In Details.Split(vbLf)
|
||||
If Line.ContainsF(".jar", True) OrElse
|
||||
If (Line.ContainsF(".jar", True) AndAlso Line.Length - Line.Replace(".jar", "").Length = 4) OrElse '只有一个 .jar
|
||||
(IsFabricDetail AndAlso Line.StartsWithF(vbTab & vbTab) AndAlso Not RegexCheck(Line, "\t\tfabric[\w-]*: Fabric")) Then ModNameLines.Add(Line)
|
||||
Next
|
||||
Log("[Crash] 崩溃报告中找到 " & ModNameLines.Count & " 个可能的 Mod 项目行")
|
||||
@@ -844,8 +867,11 @@ NextStack:
|
||||
Public Sub Output(IsHandAnalyze As Boolean, Optional ExtraFiles As List(Of String) = Nothing)
|
||||
'弹窗提示
|
||||
FrmMain.ShowWindowToTop()
|
||||
Dim ShowLog As Action =
|
||||
Select Case MyMsgBox(GetAnalyzeResult(IsHandAnalyze), If(IsHandAnalyze, "错误报告分析结果", "Minecraft 出现错误"),
|
||||
"确定", If(IsHandAnalyze OrElse DirectFile Is Nothing, "", "查看日志"), If(IsHandAnalyze, "", "导出错误报告"),
|
||||
Button2Action:=If(IsHandAnalyze OrElse DirectFile Is Nothing, Nothing,
|
||||
Sub()
|
||||
'弹窗选择:查看日志
|
||||
If File.Exists(DirectFile.Value.Key) Then
|
||||
ShellOnly("notepad", DirectFile.Value.Key)
|
||||
Else
|
||||
@@ -853,11 +879,9 @@ NextStack:
|
||||
WriteFile(FilePath, Join(DirectFile.Value.Value, vbCrLf))
|
||||
ShellOnly(FilePath)
|
||||
End If
|
||||
End Sub
|
||||
Select Case MyMsgBox(GetAnalyzeResult(IsHandAnalyze), If(IsHandAnalyze, "错误报告分析结果", "Minecraft 出现错误"),
|
||||
"确定", If(IsHandAnalyze OrElse DirectFile Is Nothing, "", "查看日志"), If(IsHandAnalyze, "", "导出错误报告"),
|
||||
Button2Action:=If(IsHandAnalyze OrElse DirectFile Is Nothing, Nothing, ShowLog))
|
||||
End Sub))
|
||||
Case 3
|
||||
'弹窗选择:导出错误报告
|
||||
Dim FileAddress As String = Nothing
|
||||
Try
|
||||
'获取文件路径
|
||||
@@ -872,16 +896,23 @@ NextStack:
|
||||
If ExtraFiles IsNot Nothing Then OutputFiles.AddRange(ExtraFiles)
|
||||
For Each OutputFile In OutputFiles
|
||||
Dim FileName As String = GetFileNameFromPath(OutputFile)
|
||||
Dim FileEncoding As Encoding = Nothing
|
||||
Select Case FileName
|
||||
Case "LatestLaunch.bat"
|
||||
FileName = "启动脚本.bat"
|
||||
Case "Log1.txt"
|
||||
FileName = "PCL 启动器日志.txt"
|
||||
FileEncoding = Encoding.UTF8
|
||||
Case "RawOutput.log"
|
||||
FileName = "游戏崩溃前的输出.txt"
|
||||
FileEncoding = Encoding.UTF8
|
||||
End Select
|
||||
If File.Exists(OutputFile) Then
|
||||
WriteFile(TempFolder & "Report\" & FileName, SecretFilter(ReadFile(OutputFile), If(FileName = "启动脚本.bat", "F", "*")))
|
||||
If FileEncoding Is Nothing Then FileEncoding = GetEncoding(ReadFileBytes(OutputFile))
|
||||
WriteFile(TempFolder & "Report\" & FileName,
|
||||
SecretFilter(ReadFile(OutputFile, FileEncoding), If(FileName = "启动脚本.bat", "F", "*")),
|
||||
Encoding:=FileEncoding)
|
||||
Log($"[Crash] 导出文件:{FileName},编码:{FileEncoding.HeaderName}")
|
||||
End If
|
||||
Next
|
||||
'导出报告
|
||||
@@ -905,7 +936,7 @@ NextStack:
|
||||
If IsHandAnalyze Then
|
||||
Return "很抱歉,PCL 无法确定错误原因。"
|
||||
Else
|
||||
Return $"很抱歉,你的游戏出现了一些问题……{vbCrLf}如果要寻求帮助,请导出错误报告并发给他人,而不是发送这个窗口的截图。"
|
||||
Return $"很抱歉,你的游戏出现了一些问题……{vbCrLf}如果要寻求帮助,请把错误报告文件发给对方,而不是发送这个窗口的照片或者截图。"
|
||||
End If
|
||||
End If
|
||||
|
||||
@@ -938,9 +969,9 @@ NextStack:
|
||||
End If
|
||||
Case CrashReason.Mod缺少前置或MC版本错误
|
||||
If Additional.Any Then
|
||||
Results.Add("由于未满足 Mod 的依赖项,导致游戏退出。\n未满足的依赖项:\n - " & Join(Additional, "\n - ") & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
|
||||
Results.Add("由于未安装正确的前置 Mod,导致游戏退出。\n缺失的依赖项:\n - " & Join(Additional, "\n - ") & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
|
||||
Else
|
||||
Results.Add("由于未满足 Mod 的依赖项,导致游戏退出。\n请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
|
||||
Results.Add("由于未安装正确的前置 Mod,导致游戏退出。\n请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
|
||||
End If
|
||||
Case CrashReason.堆栈分析发现关键字
|
||||
If Additional.Count = 1 Then
|
||||
@@ -961,7 +992,9 @@ NextStack:
|
||||
Results.Add("以下 Mod 导致了游戏出错:\n - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
|
||||
End If
|
||||
Case CrashReason.ModMixin失败
|
||||
If Additional.Count = 1 Then
|
||||
If Additional.Count = 0 Then
|
||||
Results.Add("部分 Mod 注入失败,导致游戏出错。\n这一般代表着部分 Mod 与其他 Mod 或当前环境不兼容,或是它存在 Bug。\n你可以尝试逐步禁用 Mod,然后观察游戏是否还会崩溃,以此定位导致崩溃的 Mod。\n\e\h")
|
||||
ElseIf Additional.Count = 1 Then
|
||||
Results.Add("名为 " & Additional.First & " 的 Mod 注入失败,导致游戏出错。\n这一般代表着它与其他 Mod 或当前环境不兼容,或是它存在 Bug。\n你可以尝试禁用此 Mod,然后观察游戏是否还会崩溃。\n\e\h")
|
||||
Else
|
||||
Results.Add("以下 Mod 导致了游戏出错:\n - " & Join(Additional, "\n - ") & "\n这一般代表着它们与其他 Mod 或当前环境不兼容,或是它存在 Bug。\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
|
||||
@@ -976,7 +1009,7 @@ NextStack:
|
||||
If Additional.Count = 1 Then
|
||||
Results.Add("名为 " & Additional.First & " 的 Mod 初始化失败,导致游戏无法继续加载。\n你可以尝试禁用此 Mod,然后观察游戏是否还会崩溃。\n\e\h")
|
||||
Else
|
||||
Results.Add("以下 Mod 初始化失败,导致游戏无法继续加载:\n - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
|
||||
Results.Add("以下 Mod 初始化失败,导致游戏出错:\n - " & Join(Additional, "\n - ") & "\n\n你可以尝试依次禁用上述 Mod,然后观察游戏是否还会崩溃。\n\e\h")
|
||||
End If
|
||||
Case CrashReason.特定方块导致崩溃
|
||||
If Additional.Count = 1 Then
|
||||
@@ -988,7 +1021,7 @@ NextStack:
|
||||
If Additional.Count >= 2 Then
|
||||
Results.Add("你重复安装了多个相同的 Mod:\n - " & Join(Additional, "\n - ") & "\n\n每个 Mod 只能出现一次,请删除重复的 Mod,然后再启动游戏。")
|
||||
Else
|
||||
Results.Add("你可能重复安装了多个相同的 Mod,导致游戏无法继续加载。\n\n每个 Mod 只能出现一次,请删除重复的 Mod,然后再启动游戏。\e\h")
|
||||
Results.Add("你可能重复安装了多个相同的 Mod,导致游戏出错。\n\n每个 Mod 只能出现一次,请删除重复的 Mod,然后再启动游戏。\e\h")
|
||||
End If
|
||||
Case CrashReason.特定实体导致崩溃
|
||||
If Additional.Count = 1 Then
|
||||
@@ -998,12 +1031,12 @@ NextStack:
|
||||
End If
|
||||
Case CrashReason.OptiFine与Forge不兼容
|
||||
Results.Add("由于 OptiFine 与当前版本的 Forge 不兼容,导致了游戏崩溃。\n\n请前往 OptiFine 官网(https://optifine.net/downloads)查看 OptiFine 所兼容的 Forge 版本,并严格按照对应版本重新安装游戏。")
|
||||
Case CrashReason.ShadersMod与Optifine同时安装
|
||||
Results.Add("无需同时安装 Optifine 和 Shaders Mod,Optifine 已经集成了 Shaders Mod 的功能。\n在删除 Shaders Mod 后,游戏即可正常运行。")
|
||||
Case CrashReason.ShadersMod与OptiFine同时安装
|
||||
Results.Add("无需同时安装 Optifine 和 Shaders Mod,OptiFine 已经集成了 Shaders Mod 的功能。\n在删除 Shaders Mod 后,游戏即可正常运行。")
|
||||
Case CrashReason.低版本Forge与高版本Java不兼容
|
||||
Results.Add("由于低版本 Forge 与当前 Java 不兼容,导致了游戏崩溃。\n\n请尝试以下解决方案:\n - 更新 Forge 到 36.2.26 或更高版本\n - 换用版本低于 1.8.0.320 的 Java")
|
||||
Case CrashReason.版本Json中存在多个Forge
|
||||
Results.Add("可能由于使用其他启动器修改了 Forge 版本,当前版本的文件存在异常,导致了游戏崩溃。\n请尝试重新全新安装 Forge,而非使用其他启动器修改 Forge 版本。")
|
||||
Results.Add("可能由于其他启动器修改了 Forge 版本,当前版本的文件存在异常,导致了游戏崩溃。\n请尝试重新全新安装 Forge,而非使用其他启动器修改 Forge 版本。")
|
||||
Case CrashReason.玩家手动触发调试崩溃
|
||||
Results.Add("* 事实上,你的游戏没有任何问题,这是你自己触发的崩溃。\n* 你难道没有更重要的事要做吗?")
|
||||
Case CrashReason.Mod需要Java11
|
||||
@@ -1029,30 +1062,36 @@ NextStack:
|
||||
Case CrashReason.文件或内容校验失败
|
||||
Results.Add("部分文件或内容校验失败,导致游戏出现了问题。\n\n请尝试删除游戏(包括 Mod)并重新下载,或尝试在重新下载时使用 VPN。\h")
|
||||
Case CrashReason.Forge安装不完整
|
||||
Results.Add("由于 Forge 安装不完整,导致游戏无法正常运行。\n请尝试重新安装 Forge。\h")
|
||||
Results.Add("由于安装的 Forge 文件丢失,导致游戏无法正常运行。\n请重新安装一次相同版本的 Forge,然后再启动游戏。\n在打包游戏时删除 libraries 文件夹可能导致此错误。\h")
|
||||
Case CrashReason.Fabric报错
|
||||
If Additional.Count = 1 Then
|
||||
Results.Add("Fabric 提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
|
||||
Else
|
||||
Results.Add("Fabric 可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息,可以查看错误报告了解错误具体是如何发生的。\h")
|
||||
Results.Add("Fabric 可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
|
||||
End If
|
||||
Case CrashReason.Mod互不兼容
|
||||
If Additional.Count = 1 Then
|
||||
Results.Add("你所安装的 Mod 不兼容:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
|
||||
Else
|
||||
Results.Add("你所安装的 Mod 不兼容,Mod 加载器可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
|
||||
End If
|
||||
Case CrashReason.Mod加载器报错
|
||||
If Additional.Count = 1 Then
|
||||
Results.Add("Mod 加载器提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
|
||||
Else
|
||||
Results.Add("Mod 加载器可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息,可以查看错误报告了解错误具体是如何发生的。\h")
|
||||
Results.Add("Mod 加载器可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
|
||||
End If
|
||||
Case CrashReason.Fabric报错并给出解决方案
|
||||
If Additional.Count = 1 Then
|
||||
Results.Add("Fabric 提供了以下解决方案:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
|
||||
Else
|
||||
Results.Add("Fabric 可能已经提供了解决方案,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息,可以查看错误报告了解错误具体是如何发生的。\h")
|
||||
Results.Add("Fabric 可能已经提供了解决方案,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
|
||||
End If
|
||||
Case CrashReason.Forge报错
|
||||
If Additional.Count = 1 Then
|
||||
Results.Add("Forge 提供了以下错误信息:\n" & Additional.First & "\n\n请根据上述信息进行对应处理,如果看不懂英文可以使用翻译软件。")
|
||||
Else
|
||||
Results.Add("Forge 可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\n如果没有看到报错信息,可以查看错误报告了解错误具体是如何发生的。\h")
|
||||
Results.Add("Forge 可能已经提供了错误信息,请根据错误报告中的日志信息进行对应处理,如果看不懂英文可以使用翻译软件。\h")
|
||||
End If
|
||||
Case CrashReason.没有可用的分析文件
|
||||
Results.Add("你的游戏出现了一些问题,但 PCL 未能找到相关记录文件,因此无法进行分析。\h")
|
||||
@@ -1068,7 +1107,7 @@ NextStack:
|
||||
Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr, vbCrLf).
|
||||
Trim(vbCrLf.ToCharArray) &
|
||||
If(Not Results.Any(Function(r) r.EndsWithF("\h")) OrElse IsHandAnalyze, "",
|
||||
vbCrLf & "如果要寻求帮助,请向他人发送错误报告文件,而不是发送这个窗口的截图。" &
|
||||
vbCrLf & "如果要寻求帮助,请把错误报告文件发给对方,而不是发送这个窗口的照片或者截图。" &
|
||||
If(If(PageSetupSystem.IsLauncherNewest(), True), "",
|
||||
vbCrLf & vbCrLf & "此外,你正在使用老版本 PCL,更新 PCL 或许也能解决这个问题。" & vbCrLf & "你可以点击 设置 → 启动器 → 检查更新 来更新 PCL。"))
|
||||
End Function
|
||||
|
||||
@@ -21,12 +21,7 @@
|
||||
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 Then
|
||||
'是否跳过
|
||||
Dim IsSetupSkip As Boolean = ShouldIgnoreFileCheck(Version)
|
||||
If IsSetupSkip AndAlso File.Exists(Version.Path & Version.Name & ".jar") Then Return Nothing '跳过校验
|
||||
If Checker.Check(Version.Path & Version.Name & ".jar") Is Nothing Then Return Nothing '通过校验
|
||||
End If
|
||||
If ReturnNothingOnFileUseable AndAlso Checker.Check(Version.Path & Version.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)
|
||||
@@ -56,7 +51,7 @@
|
||||
''' <summary>
|
||||
''' 构造补全某 Minecraft 版本的所有文件的加载器列表。失败会抛出异常。
|
||||
''' </summary>
|
||||
Public Function DlClientFix(Version As McVersion, CheckAssetsHash As Boolean, AssetsIndexBehaviour As AssetsIndexExistsBehaviour, SkipAssetsDownloadWhileSetupRequired As Boolean) As List(Of LoaderBase)
|
||||
Public Function DlClientFix(Version As McVersion, CheckAssetsHash As Boolean, AssetsIndexBehaviour As AssetsIndexExistsBehaviour) As List(Of LoaderBase)
|
||||
Dim Loaders As New List(Of LoaderBase)
|
||||
|
||||
#Region "下载支持库文件"
|
||||
@@ -69,9 +64,9 @@
|
||||
#End Region
|
||||
|
||||
#Region "下载资源文件"
|
||||
Dim IsSetupSkip As Boolean = ShouldIgnoreFileCheck(Version)
|
||||
If IsSetupSkip Then Log("[Download] 已跳过 Assets 下载")
|
||||
If (Not SkipAssetsDownloadWhileSetupRequired) OrElse Not IsSetupSkip Then
|
||||
If ShouldIgnoreFileCheck(Version) Then
|
||||
Log("[Download] 已跳过所有 Assets 检查")
|
||||
Else
|
||||
Dim LoadersAssets As New List(Of LoaderBase)
|
||||
'获取资源文件索引地址
|
||||
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析资源文件索引地址",
|
||||
@@ -104,7 +99,7 @@
|
||||
Task.Output = New List(Of NetFile) From {BackAssetsFile}
|
||||
'检查是否需要更新:每天只更新一次
|
||||
If File.Exists(RealAddress) AndAlso Math.Abs((File.GetLastWriteTime(RealAddress).Date - Now.Date).TotalDays) < 1 Then
|
||||
Log("[Download] 无需更新资源文件索引")
|
||||
Log("[Download] 无需更新资源文件索引,取消")
|
||||
Task.Abort()
|
||||
End If
|
||||
End Sub))
|
||||
@@ -121,7 +116,7 @@
|
||||
'获取资源文件地址
|
||||
LoadersAssets.Add(New LoaderTask(Of String, List(Of NetFile))("分析缺失资源文件",
|
||||
Sub(Task As LoaderTask(Of String, List(Of NetFile)))
|
||||
Task.Output = McAssetsFixList(McAssetsGetIndexName(Version), CheckAssetsHash, Task)
|
||||
Task.Output = McAssetsFixList(Version, CheckAssetsHash, Task)
|
||||
End Sub) With {.ProgressWeight = 3})
|
||||
'下载资源文件
|
||||
LoadersAssets.Add(New LoaderDownload("下载资源文件", New List(Of NetFile)) With {.ProgressWeight = 25})
|
||||
@@ -172,24 +167,25 @@
|
||||
End Structure
|
||||
''' <summary>
|
||||
''' Minecraft 客户端 版本列表,主加载器。
|
||||
''' 若要求镜像源必须包含某个版本,则将该版本 ID 作为输入(#5195)。
|
||||
''' </summary>
|
||||
Public DlClientListLoader As New LoaderTask(Of Integer, DlClientListResult)("DlClientList Main", AddressOf DlClientListMain)
|
||||
Private Sub DlClientListMain(Loader As LoaderTask(Of Integer, DlClientListResult))
|
||||
Public DlClientListLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Main", AddressOf DlClientListMain)
|
||||
Private Sub DlClientListMain(Loader As LoaderTask(Of String, DlClientListResult))
|
||||
Select Case Setup.Get("ToolDownloadVersion")
|
||||
Case 0
|
||||
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)) From {
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListBmclapiLoader, 30),
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListMojangLoader, 60)
|
||||
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)) From {
|
||||
New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListBmclapiLoader, 30),
|
||||
New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListMojangLoader, 30 + 60)
|
||||
}, Loader.IsForceRestarting)
|
||||
Case 1
|
||||
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)) From {
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListMojangLoader, 5),
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListBmclapiLoader, 35)
|
||||
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)) From {
|
||||
New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListMojangLoader, 5),
|
||||
New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListBmclapiLoader, 5 + 30)
|
||||
}, Loader.IsForceRestarting)
|
||||
Case Else
|
||||
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)) From {
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListMojangLoader, 60),
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlClientListResult), Integer)(DlClientListBmclapiLoader, 60)
|
||||
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)) From {
|
||||
New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListMojangLoader, 60),
|
||||
New KeyValuePair(Of LoaderTask(Of String, DlClientListResult), Integer)(DlClientListBmclapiLoader, 60 + 60)
|
||||
}, Loader.IsForceRestarting)
|
||||
End Select
|
||||
End Sub
|
||||
@@ -198,9 +194,9 @@
|
||||
''' <summary>
|
||||
''' Minecraft 客户端 版本列表,Mojang 官方源加载器。
|
||||
''' </summary>
|
||||
Public DlClientListMojangLoader As New LoaderTask(Of Integer, DlClientListResult)("DlClientList Mojang", AddressOf DlClientListMojangMain)
|
||||
Public DlClientListMojangLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Mojang", AddressOf DlClientListMojangMain)
|
||||
Private IsNewClientVersionHinted As Boolean = False
|
||||
Private Sub DlClientListMojangMain(Loader As LoaderTask(Of Integer, DlClientListResult))
|
||||
Private Sub DlClientListMojangMain(Loader As LoaderTask(Of String, DlClientListResult))
|
||||
Dim Json As JObject = NetGetCodeByRequestRetry("https://launchermeta.mojang.com/mc/game/version_manifest.json", IsJson:=True)
|
||||
Try
|
||||
Dim Versions As JArray = Json("versions")
|
||||
@@ -230,14 +226,21 @@
|
||||
''' <summary>
|
||||
''' Minecraft 客户端 版本列表,BMCLAPI 源加载器。
|
||||
''' </summary>
|
||||
Public DlClientListBmclapiLoader As New LoaderTask(Of Integer, DlClientListResult)("DlClientList Bmclapi", AddressOf DlClientListBmclapiMain)
|
||||
Private Sub DlClientListBmclapiMain(Loader As LoaderTask(Of Integer, DlClientListResult))
|
||||
Public DlClientListBmclapiLoader As New LoaderTask(Of String, DlClientListResult)("DlClientList Bmclapi", AddressOf DlClientListBmclapiMain)
|
||||
Private Sub DlClientListBmclapiMain(Loader As LoaderTask(Of String, DlClientListResult))
|
||||
Dim Json As JObject = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/mc/game/version_manifest.json", IsJson:=True)
|
||||
Try
|
||||
Dim Versions As JArray = Json("versions")
|
||||
If Versions.Count < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Json.ToString & ")")
|
||||
'添加 PCL 特供项
|
||||
If File.Exists(PathTemp & "Cache\download.json") Then Versions.Merge(GetJson(ReadFile(PathTemp & "Cache\download.json")))
|
||||
'检查是否有要求的版本(#5195)
|
||||
If Not String.IsNullOrEmpty(Loader.Input) Then
|
||||
Dim Id = Loader.Input
|
||||
If Not DlClientListLoader.Output.Value("versions").Any(Function(v) v("id") = Id) Then
|
||||
Throw New Exception("BMCLAPI 源未包含目标版本 " & Id)
|
||||
End If
|
||||
End If
|
||||
'返回
|
||||
Loader.Output = New DlClientListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Json}
|
||||
Catch ex As Exception
|
||||
@@ -250,26 +253,31 @@
|
||||
''' </summary>
|
||||
Public Function DlClientListGet(Id As String)
|
||||
Try
|
||||
'确认 Minecraft 版本列表已完成获取
|
||||
Select Case DlClientListLoader.State
|
||||
Case LoadState.Loading
|
||||
DlClientListLoader.WaitForExit()
|
||||
Case LoadState.Failed, LoadState.Aborted, LoadState.Waiting
|
||||
DlClientListLoader.WaitForExit(IsForceRestart:=True)
|
||||
End Select
|
||||
'确认版本格式标准
|
||||
Id = Id.Replace("_", "-") '1.7.10_pre4 在版本列表中显示为 1.7.10-pre4
|
||||
If Id <> "1.0" AndAlso Id.EndsWithF(".0") Then Id = Left(Id, Id.Length - 2) 'OptiFine 1.8 的下载会触发此问题,显示版本为 1.8.0
|
||||
'查找版本并开始
|
||||
'获取 Minecraft 版本列表
|
||||
Select Case DlClientListLoader.State
|
||||
Case LoadState.Finished
|
||||
'从当前的结果获取目标版本…
|
||||
For Each Version As JObject In DlClientListLoader.Output.Value("versions")
|
||||
If Version("id") = Id Then Return Version("url").ToString
|
||||
Next
|
||||
'…如果没有,则重新尝试获取(在版本刚更新时可能出现这种情况,#5195)
|
||||
DlClientListLoader.WaitForExit(Id, IsForceRestart:=True)
|
||||
Case LoadState.Loading
|
||||
DlClientListLoader.WaitForExit(Id)
|
||||
Case LoadState.Failed, LoadState.Aborted, LoadState.Waiting
|
||||
DlClientListLoader.WaitForExit(Id, IsForceRestart:=True)
|
||||
End Select
|
||||
'重新查找版本
|
||||
For Each Version As JObject In DlClientListLoader.Output.Value("versions")
|
||||
If Version("id") = Id Then
|
||||
Return Version("url").ToString
|
||||
End If
|
||||
If Version("id") = Id Then Return Version("url").ToString
|
||||
Next
|
||||
Log("未发现版本 " & Id & " 的 json 下载地址,版本列表返回为:" & vbCrLf & DlClientListLoader.Output.Value.ToString, LogLevel.Debug)
|
||||
Log($"未发现版本 {Id} 的 json 下载地址,版本列表返回为:{vbCrLf}{DlClientListLoader.Output.Value.ToString}", LogLevel.Debug)
|
||||
Return Nothing
|
||||
Catch ex As Exception
|
||||
Log(ex, "获取版本 " & Id & " 的 json 下载地址失败")
|
||||
Log(ex, $"获取版本 {Id} 的 json 下载地址失败")
|
||||
Return Nothing
|
||||
End Try
|
||||
End Function
|
||||
@@ -342,17 +350,17 @@
|
||||
Case 0
|
||||
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)) From {
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 30),
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListOfficialLoader, 60)
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListOfficialLoader, 30 + 60)
|
||||
}, Loader.IsForceRestarting)
|
||||
Case 1
|
||||
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)) From {
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListOfficialLoader, 5),
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 35)
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 5 + 30)
|
||||
}, Loader.IsForceRestarting)
|
||||
Case Else
|
||||
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)) From {
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListOfficialLoader, 60),
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 60)
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlOptiFineListResult), Integer)(DlOptiFineListBmclapiLoader, 60 + 60)
|
||||
}, Loader.IsForceRestarting)
|
||||
End Select
|
||||
End Sub
|
||||
@@ -448,17 +456,17 @@
|
||||
Case 0
|
||||
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)) From {
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 30),
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListOfficialLoader, 60)
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListOfficialLoader, 30 + 60)
|
||||
}, Loader.IsForceRestarting)
|
||||
Case 1
|
||||
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)) From {
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListOfficialLoader, 5),
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 35)
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 5 + 30)
|
||||
}, Loader.IsForceRestarting)
|
||||
Case Else
|
||||
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)) From {
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListOfficialLoader, 60),
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 60)
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlForgeListResult), Integer)(DlForgeListBmclapiLoader, 60 + 60)
|
||||
}, Loader.IsForceRestarting)
|
||||
End Select
|
||||
End Sub
|
||||
@@ -593,17 +601,17 @@
|
||||
Case 0
|
||||
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)) From {
|
||||
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 30),
|
||||
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionOfficialLoader, 60)
|
||||
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionOfficialLoader, 30 + 60)
|
||||
}, Loader.IsForceRestarting)
|
||||
Case 1
|
||||
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)) From {
|
||||
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionOfficialLoader, 5),
|
||||
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 35)
|
||||
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 5 + 30)
|
||||
}, Loader.IsForceRestarting)
|
||||
Case Else
|
||||
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)) From {
|
||||
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionOfficialLoader, 60),
|
||||
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 60)
|
||||
New KeyValuePair(Of LoaderTask(Of String, List(Of DlForgeVersionEntry)), Integer)(DlForgeVersionBmclapiLoader, 60 + 60)
|
||||
}, Loader.IsForceRestarting)
|
||||
End Select
|
||||
End Sub
|
||||
@@ -785,7 +793,7 @@
|
||||
Inherit = "1.20.1"
|
||||
Else '20.4.30-beta
|
||||
VersionName = ApiName
|
||||
Version = New Version(ApiName.Before("-"))
|
||||
Version = New Version(ApiName.BeforeFirst("-"))
|
||||
Inherit = $"1.{Version.Major}" & If(Version.Minor = 0, "", "." & Version.Minor)
|
||||
End If
|
||||
End Sub
|
||||
@@ -800,17 +808,17 @@
|
||||
Case 0
|
||||
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)) From {
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 30),
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListOfficialLoader, 60)
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListOfficialLoader, 30 + 60)
|
||||
}, Loader.IsForceRestarting)
|
||||
Case 1
|
||||
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)) From {
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListOfficialLoader, 5),
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 35)
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 5 + 30)
|
||||
}, Loader.IsForceRestarting)
|
||||
Case Else
|
||||
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)) From {
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListOfficialLoader, 60),
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 60)
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlNeoForgeListResult), Integer)(DlNeoForgeListBmclapiLoader, 60 + 60)
|
||||
}, Loader.IsForceRestarting)
|
||||
End Select
|
||||
End Sub
|
||||
@@ -836,8 +844,8 @@
|
||||
''' <summary>
|
||||
''' NeoForge 版本列表,BMCLAPI。
|
||||
''' </summary>
|
||||
Public DlNeoForgeListBmclapiLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Bmclapi", AddressOf DlNeoForgeListOfficialMain)
|
||||
Public Sub DlNeoForgeVersionBmclapiMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
|
||||
Public DlNeoForgeListBmclapiLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Bmclapi", AddressOf DlNeoForgeListBmclapiMain)
|
||||
Public Sub DlNeoForgeListBmclapiMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
|
||||
'获取版本列表 JSON
|
||||
Dim ResultLatest As String = NetGetCodeByDownload("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/neoforge", UseBrowserUserAgent:=True, IsJson:=True)
|
||||
Dim ResultLegacy As String = NetGetCodeByDownload("https://bmclapi2.bangbang93.com/neoforge/meta/api/maven/details/releases/net/neoforged/forge", UseBrowserUserAgent:=True, IsJson:=True)
|
||||
@@ -925,17 +933,17 @@
|
||||
Case 0
|
||||
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)) From {
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 30),
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListOfficialLoader, 60)
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListOfficialLoader, 30 + 60)
|
||||
}, Loader.IsForceRestarting)
|
||||
Case 1
|
||||
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)) From {
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListOfficialLoader, 5),
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 35)
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 5 + 30)
|
||||
}, Loader.IsForceRestarting)
|
||||
Case Else
|
||||
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)) From {
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListOfficialLoader, 60),
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 60)
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlLiteLoaderListResult), Integer)(DlLiteLoaderListBmclapiLoader, 60 + 60)
|
||||
}, Loader.IsForceRestarting)
|
||||
End Select
|
||||
End Sub
|
||||
@@ -1024,17 +1032,17 @@
|
||||
Case 0
|
||||
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)) From {
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 30),
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListOfficialLoader, 60)
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListOfficialLoader, 30 + 60)
|
||||
}, Loader.IsForceRestarting)
|
||||
Case 1
|
||||
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)) From {
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListOfficialLoader, 5),
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 35)
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 5 + 30)
|
||||
}, Loader.IsForceRestarting)
|
||||
Case Else
|
||||
DlSourceLoader(Loader, New List(Of KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)) From {
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListOfficialLoader, 60),
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 60)
|
||||
New KeyValuePair(Of LoaderTask(Of Integer, DlFabricListResult), Integer)(DlFabricListBmclapiLoader, 60 + 60)
|
||||
}, Loader.IsForceRestarting)
|
||||
End Select
|
||||
End Sub
|
||||
@@ -1083,29 +1091,145 @@
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "DlMod | Mod 镜像源请求"
|
||||
|
||||
''' <summary>
|
||||
''' 对可能涉及 Mod 镜像源的请求进行处理,返回字符串或 JObject。
|
||||
''' 调用 NetGetCodeByRequest。
|
||||
''' </summary>
|
||||
Public Function DlModRequest(Url As String, Optional IsJson As Boolean = False) As Object
|
||||
Dim Urls As New List(Of KeyValuePair(Of String, Integer))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 15))
|
||||
'Dim McimUrl As String = DlSourceModGet(Url)
|
||||
'If McimUrl <> Url Then
|
||||
' Select Case Setup.Get("ToolDownloadMod")
|
||||
' Case 0
|
||||
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 5))
|
||||
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
|
||||
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 15))
|
||||
' Case 1
|
||||
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
|
||||
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 5))
|
||||
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 15))
|
||||
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
|
||||
' Case Else
|
||||
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
|
||||
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 15))
|
||||
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
|
||||
' End Select
|
||||
'End If
|
||||
Dim Exs As String = ""
|
||||
For Each Source In Urls
|
||||
Try
|
||||
Return NetGetCodeByRequestOnce(Source.Key, Encode:=Encoding.UTF8, Timeout:=Source.Value * 1000, IsJson:=IsJson, UseBrowserUserAgent:=True)
|
||||
Catch ex As Exception
|
||||
Exs += ex.Message + vbCrLf
|
||||
End Try
|
||||
Next
|
||||
Throw New Exception(Exs)
|
||||
End Function
|
||||
|
||||
''' <summary>
|
||||
''' 对可能涉及 Mod 镜像源的请求进行处理。
|
||||
''' 调用 NetRequest。
|
||||
''' </summary>
|
||||
Public Function DlModRequest(Url As String, Method As String, Data As String, ContentType As String) As String
|
||||
Dim Urls As New List(Of KeyValuePair(Of String, Integer))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
|
||||
Urls.Add(New KeyValuePair(Of String, Integer)(Url, 15))
|
||||
'Dim McimUrl As String = DlSourceModGet(Url)
|
||||
'If McimUrl <> Url Then
|
||||
' Select Case Setup.Get("ToolDownloadMod")
|
||||
' Case 0
|
||||
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 5))
|
||||
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
|
||||
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 15))
|
||||
' Case 1
|
||||
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
|
||||
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 5))
|
||||
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 15))
|
||||
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
|
||||
' Case Else
|
||||
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 5))
|
||||
' Urls.Add(New KeyValuePair(Of String, Integer)(Url, 15))
|
||||
' Urls.Add(New KeyValuePair(Of String, Integer)(McimUrl, 10))
|
||||
' End Select
|
||||
'End If
|
||||
Dim Exs As String = ""
|
||||
For Each Source In Urls
|
||||
Try
|
||||
Return NetRequestOnce(Source.Key, Method, Data, ContentType, Timeout:=Source.Value * 1000)
|
||||
Catch ex As Exception
|
||||
Exs += ex.Message + vbCrLf
|
||||
End Try
|
||||
Next
|
||||
Throw New Exception(Exs)
|
||||
End Function
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "DlSource | 镜像下载源"
|
||||
|
||||
Public Function DlSourceResourceGet(MojangBase As String) As String()
|
||||
MojangBase = MojangBase.Replace("http://resources.download.minecraft.net", "https://resources.download.minecraft.net")
|
||||
Public Function DlSourceResourceGet(Original As String) As String()
|
||||
Original = Original.Replace("http://resources.download.minecraft.net", "https://resources.download.minecraft.net")
|
||||
Return {
|
||||
MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/assets").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/assets").Replace("https://resources.download.minecraft.net", "https://bmclapi2.bangbang93.com/assets"),
|
||||
MojangBase
|
||||
Original.
|
||||
Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/assets").
|
||||
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/assets").
|
||||
Replace("https://resources.download.minecraft.net", "https://bmclapi2.bangbang93.com/assets"),
|
||||
Original
|
||||
}
|
||||
End Function
|
||||
|
||||
Public Function DlSourceLibraryGet(MojangBase As String) As String()
|
||||
Return {
|
||||
MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/maven").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/maven").Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/maven"),
|
||||
MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/libraries").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/libraries").Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/libraries"),
|
||||
MojangBase
|
||||
}
|
||||
Public Function DlSourceLibraryGet(Original As String) As String()
|
||||
If {"minecraftforge", "fabricmc", "neoforged"}.Any(Function(k) Original.Contains(k)) Then '不添加原版源
|
||||
Return {
|
||||
Original.
|
||||
Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/maven").
|
||||
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/maven").
|
||||
Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/maven"),
|
||||
Original.
|
||||
Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/libraries").
|
||||
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/libraries").
|
||||
Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/libraries")
|
||||
}
|
||||
Else
|
||||
Return {
|
||||
Original.
|
||||
Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/maven").
|
||||
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/maven").
|
||||
Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/maven"),
|
||||
Original.
|
||||
Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com/libraries").
|
||||
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com/libraries").
|
||||
Replace("https://libraries.minecraft.net", "https://bmclapi2.bangbang93.com/libraries"),
|
||||
Original
|
||||
}
|
||||
End If
|
||||
End Function
|
||||
|
||||
Public Function DlSourceLauncherOrMetaGet(MojangBase As String) As String()
|
||||
If MojangBase Is Nothing Then Throw New Exception("无对应的 json 下载地址")
|
||||
Public Function DlSourceModGet(Original As String) As String
|
||||
Return Original
|
||||
'Return Original.
|
||||
' Replace("api.modrinth.com", "mod.mcimirror.top/modrinth").
|
||||
' Replace("staging-api.modrinth.com", "mod.mcimirror.top/modrinth").
|
||||
' Replace("cdn.modrinth.com", "mod.mcimirror.top").
|
||||
' Replace("api.curseforge.com", "mod.mcimirror.top/curseforge").
|
||||
' Replace("edge.forgecdn.net", "mod.mcimirror.top").
|
||||
' Replace("mediafilez.forgecdn.net", "mod.mcimirror.top").
|
||||
' Replace("media.forgecdn.net", "mod.mcimirror.top")
|
||||
End Function
|
||||
|
||||
Public Function DlSourceLauncherOrMetaGet(Original As String) As String()
|
||||
If Original Is Nothing Then Throw New Exception("无对应的 json 下载地址")
|
||||
Return {
|
||||
MojangBase.Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://launcher.mojang.com", "https://bmclapi2.bangbang93.com").Replace("https://launchermeta.mojang.com", "https://bmclapi2.bangbang93.com"),
|
||||
MojangBase
|
||||
Original.
|
||||
Replace("https://piston-data.mojang.com", "https://bmclapi2.bangbang93.com").
|
||||
Replace("https://piston-meta.mojang.com", "https://bmclapi2.bangbang93.com").
|
||||
Replace("https://launcher.mojang.com", "https://bmclapi2.bangbang93.com").
|
||||
Replace("https://launchermeta.mojang.com", "https://bmclapi2.bangbang93.com"),
|
||||
Original
|
||||
}
|
||||
End Function
|
||||
|
||||
@@ -1114,71 +1238,63 @@
|
||||
Optional IsForceRestart As Boolean = False)
|
||||
Dim WaitCycle As Integer = 0
|
||||
Do While True
|
||||
'检查加载结束
|
||||
Dim IsAllFailed As Boolean = True
|
||||
'检查状态
|
||||
Dim BeforeLoadersAllFailed As Boolean = True
|
||||
For Each SubLoader In LoaderList
|
||||
If WaitCycle = 0 Then
|
||||
'如果要强制刷新,就不使用已经加载好的值
|
||||
If IsForceRestart Then Exit For
|
||||
'如果输入不一样,就不使用已经加载好的值
|
||||
If WaitCycle = 0 Then '判断是否可以不加载,直接使用已经加载好的结果
|
||||
If IsForceRestart Then Continue For '强制刷新,不行
|
||||
If (SubLoader.Key.Input Is Nothing Xor MainLoader.Input Is Nothing) OrElse
|
||||
(SubLoader.Key.Input IsNot Nothing AndAlso Not SubLoader.Key.Input.Equals(MainLoader.Input)) Then Continue For
|
||||
(SubLoader.Key.Input IsNot Nothing AndAlso Not SubLoader.Key.Input.Equals(MainLoader.Input)) Then Continue For '父子加载器的输入不一样,也不行
|
||||
End If
|
||||
If SubLoader.Key.State <> LoadState.Failed Then IsAllFailed = False
|
||||
If SubLoader.Key.State <> LoadState.Failed Then BeforeLoadersAllFailed = False
|
||||
If SubLoader.Key.State = LoadState.Finished Then
|
||||
'检查加载器成功
|
||||
MainLoader.Output = SubLoader.Key.Output
|
||||
DlSourceLoaderAbort(LoaderList)
|
||||
Exit Sub
|
||||
ElseIf IsAllFailed Then
|
||||
ElseIf BeforeLoadersAllFailed Then
|
||||
'此前的加载器全部失败,直接启动后续加载器
|
||||
If WaitCycle < SubLoader.Value * 100 Then WaitCycle = SubLoader.Value * 100
|
||||
End If
|
||||
'由于 Forge BMCLAPI 没有可用版本导致强制失败
|
||||
'在没有可用版本时,官方源会一直卡住,直接使用 BMCLAPI 判定失败即可
|
||||
If SubLoader.Key.Error IsNot Nothing AndAlso SubLoader.Key.Error.Message.Contains("没有可用版本") Then
|
||||
For Each SubLoader2 In LoaderList
|
||||
If WaitCycle < SubLoader2.Value * 100 Then WaitCycle = SubLoader2.Value * 100
|
||||
Next
|
||||
End If
|
||||
Next
|
||||
'启动加载源
|
||||
'第一轮时:既然不直接使用已经加载好的结果,那就启动第一个加载器
|
||||
If WaitCycle = 0 Then
|
||||
'启动第一个源
|
||||
LoaderList(0).Key.Start(MainLoader.Input, IsForceRestart)
|
||||
'将其他源标记为未启动,以确保可以切换下载源(#184)
|
||||
For i = 1 To LoaderList.Count - 1
|
||||
LoaderList(i).Key.State = LoadState.Waiting
|
||||
LoaderList.First.Key.Start(MainLoader.Input, IsForceRestart)
|
||||
For Each Loader In LoaderList.Skip(1)
|
||||
Loader.Key.State = LoadState.Waiting '将其他源标记为未启动,以确保可以切换下载源(#184)
|
||||
Next
|
||||
End If
|
||||
'检查加载器失败或超时
|
||||
For i = 0 To LoaderList.Count - 1
|
||||
If WaitCycle = LoaderList(i).Value * 100 Then
|
||||
If i < LoaderList.Count - 1 Then
|
||||
'启动下一个源
|
||||
LoaderList(i + 1).Key.Start(MainLoader.Input, IsForceRestart)
|
||||
Else
|
||||
'失败
|
||||
Dim ErrorInfo As Exception = Nothing
|
||||
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
|
||||
ErrorInfo = LoaderList(ii).Key.Error
|
||||
End If
|
||||
If WaitCycle <> LoaderList(i).Value * 100 Then Continue For
|
||||
If i < LoaderList.Count - 1 AndAlso Not LoaderList.All(Function(l) l.Key.State = LoadState.Failed) Then
|
||||
'若还有下一个源,则启动下一个源
|
||||
LoaderList(i + 1).Key.Start(MainLoader.Input, IsForceRestart)
|
||||
Else
|
||||
'若没有,则失败
|
||||
Dim ErrorInfo As Exception = Nothing
|
||||
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
|
||||
ErrorInfo = LoaderList(ii).Key.Error
|
||||
End If
|
||||
Next
|
||||
If ErrorInfo Is Nothing Then ErrorInfo = New TimeoutException("下载源连接超时")
|
||||
DlSourceLoaderAbort(LoaderList)
|
||||
Throw ErrorInfo
|
||||
End If
|
||||
Exit For
|
||||
End If
|
||||
Next
|
||||
If ErrorInfo Is Nothing Then ErrorInfo = New TimeoutException("下载源连接超时")
|
||||
DlSourceLoaderAbort(LoaderList)
|
||||
Throw ErrorInfo
|
||||
End If
|
||||
Exit For
|
||||
Next
|
||||
'计时
|
||||
Thread.Sleep(10)
|
||||
WaitCycle += 1
|
||||
'检查父加载器中断
|
||||
If MainLoader.IsAborted Then
|
||||
DlSourceLoaderAbort(LoaderList)
|
||||
Exit Sub
|
||||
End If
|
||||
Thread.Sleep(10)
|
||||
WaitCycle += 1
|
||||
Loop
|
||||
End Sub
|
||||
Private Sub DlSourceLoaderAbort(Of InputType, OutputType)(LoaderList As List(Of KeyValuePair(Of LoaderTask(Of InputType, OutputType), Integer)))
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
Public Module ModJava
|
||||
Public JavaListCacheVersion As Integer = 6
|
||||
Public JavaListCacheVersion As Integer = 7
|
||||
|
||||
''' <summary>
|
||||
''' 目前所有可用的 Java。
|
||||
@@ -216,10 +216,12 @@
|
||||
|
||||
'添加特定的 Java
|
||||
Dim JavaPreList As New Dictionary(Of String, Boolean)
|
||||
If PathMcFolder.Split("\").Count > 3 Then
|
||||
JavaSearchFolder(GetPathFromFullPath(PathMcFolder), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹(如果不是根目录的话)
|
||||
If PathMcFolder.Split("\").Count > 3 AndAlso Not PathMcFolder.Contains("AppData\Roaming") Then
|
||||
JavaSearchFolder(GetPathFromFullPath(PathMcFolder), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹(如果不是根目录或 %APPDATA% 的话)
|
||||
End If
|
||||
JavaSearchFolder(PathMcFolder, 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) '所选版本文件夹
|
||||
Dim TargetJavaList As New List(Of JavaEntry)
|
||||
For Each Entry In JavaPreList
|
||||
@@ -487,16 +489,18 @@ NoUserJava:
|
||||
Public JavaSearchLoader As New LoaderTask(Of Integer, Integer)("查找 Java", AddressOf JavaSearchLoaderSub) With {.ProgressWeight = 2}
|
||||
Private Sub JavaSearchLoaderSub(Loader As LoaderTask(Of Integer, Integer))
|
||||
If FrmSetupLaunch IsNot Nothing Then
|
||||
RunInUiWait(Sub()
|
||||
FrmSetupLaunch.ComboArgumentJava.Items.Clear()
|
||||
FrmSetupLaunch.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True})
|
||||
End Sub)
|
||||
RunInUiWait(
|
||||
Sub()
|
||||
FrmSetupLaunch.ComboArgumentJava.Items.Clear()
|
||||
FrmSetupLaunch.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True})
|
||||
End Sub)
|
||||
End If
|
||||
If FrmVersionSetup IsNot Nothing Then
|
||||
RunInUiWait(Sub()
|
||||
FrmVersionSetup.ComboArgumentJava.Items.Clear()
|
||||
FrmVersionSetup.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True})
|
||||
End Sub)
|
||||
RunInUiWait(
|
||||
Sub()
|
||||
FrmVersionSetup.ComboArgumentJava.Items.Clear()
|
||||
FrmVersionSetup.ComboArgumentJava.Items.Add(New ComboBoxItem With {.Content = "加载中……", .IsSelected = True})
|
||||
End Sub)
|
||||
End If
|
||||
|
||||
Try
|
||||
@@ -518,6 +522,7 @@ NoUserJava:
|
||||
Next
|
||||
'查找磁盘中的 Java
|
||||
For Each Disk As DriveInfo In DriveInfo.GetDrives()
|
||||
If Disk.DriveType = DriveType.Network Then Continue For '跳过网络驱动器(#3705)
|
||||
JavaSearchFolder(Disk.Name, JavaPreList, False)
|
||||
Next
|
||||
'查找 APPDATA 文件夹中的 Java
|
||||
@@ -550,7 +555,7 @@ NoUserJava:
|
||||
'若不全为特殊引用,则清除特殊引用的地址
|
||||
Dim JavaWithoutInherit As New Dictionary(Of String, Boolean)
|
||||
For Each Pair In JavaPreList
|
||||
If Pair.Key.Contains("javapath_target_") OrElse Pair.Key.Contains("javatmp") Then
|
||||
If Pair.Key.Contains("java8path_target_") OrElse Pair.Key.Contains("javapath_target_") OrElse Pair.Key.Contains("javatmp") Then
|
||||
Log("[Java] 位于 " & Pair.Key & " 的 Java 包含特殊引用")
|
||||
Else
|
||||
Log("[Java] 位于 " & Pair.Key & " 的 Java 不含特殊引用")
|
||||
@@ -679,8 +684,8 @@ Wait:
|
||||
For Each FolderInfo As DirectoryInfo In OriginalPath.EnumerateDirectories
|
||||
If FolderInfo.Attributes.HasFlag(FileAttributes.ReparsePoint) Then Continue For '跳过符号链接
|
||||
Dim SearchEntry = GetFolderNameFromPath(FolderInfo.Name).ToLower '用于搜索的字符串
|
||||
If IsFullSearch OrElse FolderInfo.Parent.Name.ToLower = "users" OrElse
|
||||
Keywords.Any(Function(w) SearchEntry.Contains(w)) OrElse SearchEntry = "bin" Then
|
||||
If IsFullSearch OrElse
|
||||
FolderInfo.Parent.Name.ToLower = "users" OrElse Val(SearchEntry) > 0 OrElse Keywords.Any(Function(w) SearchEntry.Contains(w)) OrElse SearchEntry = "bin" Then
|
||||
JavaSearchFolder(FolderInfo, Results, Source)
|
||||
End If
|
||||
Next
|
||||
|
||||
@@ -4,6 +4,7 @@ Public Module ModLaunch
|
||||
|
||||
#Region "开始"
|
||||
|
||||
Public CurrentLaunchOptions As McLaunchOptions = Nothing
|
||||
Public Class McLaunchOptions
|
||||
''' <summary>
|
||||
''' 强制指定在启动后进入的服务器 IP。
|
||||
@@ -20,32 +21,34 @@ Public Module ModLaunch
|
||||
''' 默认值:Nothing。使用 McVersionCurrent。
|
||||
''' </summary>
|
||||
Public Version As McVersion = Nothing
|
||||
''' <summary>
|
||||
''' 额外的启动参数。
|
||||
''' </summary>
|
||||
Public ExtraArgs As New List(Of String)
|
||||
End Class
|
||||
''' <summary>
|
||||
''' 尝试启动 Minecraft。必须在 UI 线程调用。
|
||||
''' 返回是否实际开始了启动(如果没有,则一定弹出了错误提示)。
|
||||
''' </summary>
|
||||
Public Function McLaunchStart(Optional Options As McLaunchOptions = Nothing) As Boolean
|
||||
Options = If(Options, New McLaunchOptions)
|
||||
CurrentLaunchOptions = If(Options, New McLaunchOptions)
|
||||
'预检查
|
||||
If Not RunInUi() Then
|
||||
Throw New Exception("McLaunchStart 必须在 UI 线程调用!")
|
||||
End If
|
||||
If Not RunInUi() Then Throw New Exception("McLaunchStart 必须在 UI 线程调用!")
|
||||
If McLaunchLoader.State = LoadState.Loading Then
|
||||
Hint("已有游戏正在启动中!", HintType.Critical)
|
||||
Return False
|
||||
End If
|
||||
'强制切换需要启动的版本
|
||||
If Options.Version IsNot Nothing AndAlso McVersionCurrent <> Options.Version Then
|
||||
McLaunchLog("在启动前切换到版本 " & Options.Version.Name)
|
||||
If CurrentLaunchOptions.Version IsNot Nothing AndAlso McVersionCurrent <> CurrentLaunchOptions.Version Then
|
||||
McLaunchLog("在启动前切换到版本 " & CurrentLaunchOptions.Version.Name)
|
||||
'检查版本
|
||||
Options.Version.Load()
|
||||
If Options.Version.State = McVersionState.Error Then
|
||||
Hint("无法启动 Minecraft:" & Options.Version.Info, HintType.Critical)
|
||||
CurrentLaunchOptions.Version.Load()
|
||||
If CurrentLaunchOptions.Version.State = McVersionState.Error Then
|
||||
Hint("无法启动 Minecraft:" & CurrentLaunchOptions.Version.Info, HintType.Critical)
|
||||
Return False
|
||||
End If
|
||||
'切换版本
|
||||
McVersionCurrent = Options.Version
|
||||
McVersionCurrent = CurrentLaunchOptions.Version
|
||||
Setup.Set("LaunchVersionSelect", McVersionCurrent.Name)
|
||||
FrmLaunchLeft.RefreshButtonsUI()
|
||||
FrmLaunchLeft.RefreshPage(False, False)
|
||||
@@ -95,7 +98,7 @@ Public Module ModLaunch
|
||||
McLaunchPrecheck()
|
||||
McLaunchLog("预检测已通过")
|
||||
Catch ex As Exception
|
||||
Hint(ex.Message, HintType.Critical)
|
||||
If Not ex.Message.StartsWithF("$$") Then Hint(ex.Message, HintType.Critical)
|
||||
Throw
|
||||
End Try
|
||||
'正式加载
|
||||
@@ -103,8 +106,8 @@ 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,
|
||||
New LoaderCombo(Of String)("补全文件", DlClientFix(McVersionCurrent, False, AssetsIndexExistsBehaviour.DownloadInBackground, True)) With {.ProgressWeight = 15, .Show = False},
|
||||
McLoginLoader, '.ProgressWeight = 15, .Block = False
|
||||
New LoaderCombo(Of String)("补全文件", DlClientFix(McVersionCurrent, False, AssetsIndexExistsBehaviour.DownloadInBackground)) With {.ProgressWeight = 15, .Show = False},
|
||||
New LoaderTask(Of String, List(Of McLibToken))("获取启动参数", AddressOf McLaunchArgumentMain) With {.ProgressWeight = 2},
|
||||
New LoaderTask(Of List(Of McLibToken), Integer)("解压文件", AddressOf McLaunchNatives) With {.ProgressWeight = 2},
|
||||
New LoaderTask(Of Integer, Integer)("预启动处理", AddressOf McLaunchPrerun) With {.ProgressWeight = 1},
|
||||
@@ -144,7 +147,7 @@ Public Module ModLaunch
|
||||
Hint(McVersionCurrent.Name & " 启动成功!", HintType.Finish)
|
||||
Case LoadState.Aborted
|
||||
If AbortHint Is Nothing Then
|
||||
Hint(If(Loader.Input.SaveBatch Is Nothing, "已取消启动!", "已取消导出启动脚本!"), HintType.Info)
|
||||
Hint(If(CurrentLaunchOptions?.SaveBatch Is Nothing, "已取消启动!", "已取消导出启动脚本!"), HintType.Info)
|
||||
Else
|
||||
Hint(AbortHint, HintType.Finish)
|
||||
End If
|
||||
@@ -159,7 +162,7 @@ NextInner:
|
||||
If CurrentEx.Message.StartsWithF("$") Then
|
||||
'若有以 $ 开头的错误信息,则以此为准显示提示
|
||||
'若错误信息为 $$,则不提示
|
||||
If Not CurrentEx.Message = "$$" Then MyMsgBox(CurrentEx.Message.TrimStart("$"), If(Loader.Input.SaveBatch Is Nothing, "启动失败", "导出启动脚本失败"))
|
||||
If Not CurrentEx.Message = "$$" Then MyMsgBox(CurrentEx.Message.TrimStart("$"), If(CurrentLaunchOptions?.SaveBatch Is Nothing, "启动失败", "导出启动脚本失败"))
|
||||
Throw
|
||||
ElseIf CurrentEx.InnerException IsNot Nothing Then
|
||||
'检查下一级错误
|
||||
@@ -168,7 +171,9 @@ NextInner:
|
||||
Else
|
||||
'没有特殊处理过的错误信息
|
||||
McLaunchLog("错误:" & GetExceptionDetail(ex))
|
||||
Log(ex, If(Loader.Input.SaveBatch Is Nothing, "Minecraft 启动失败", "导出启动脚本失败"), LogLevel.Msgbox, If(Loader.Input.SaveBatch Is Nothing, "启动失败", "导出启动脚本失败"))
|
||||
Log(ex,
|
||||
If(CurrentLaunchOptions?.SaveBatch Is Nothing, "Minecraft 启动失败", "导出启动脚本失败"), LogLevel.Msgbox,
|
||||
If(CurrentLaunchOptions?.SaveBatch Is Nothing, "启动失败", "导出启动脚本失败"))
|
||||
Throw
|
||||
End If
|
||||
End Try
|
||||
@@ -211,36 +216,48 @@ NextInner:
|
||||
If McVersionCurrent.State = McVersionState.Error Then Throw New Exception("Minecraft 存在问题:" & McVersionCurrent.Info)
|
||||
'检查输入信息
|
||||
Dim CheckResult As String = ""
|
||||
RunInUiWait(Sub()
|
||||
Dim LoginInput As McLoginData = McLoginInput()
|
||||
CheckResult = McLoginAble(LoginInput)
|
||||
End Sub)
|
||||
RunInUiWait(Sub() CheckResult = McLoginAble(McLoginInput()))
|
||||
If CheckResult <> "" Then Throw New ArgumentException(CheckResult)
|
||||
#If BETA Then
|
||||
'求赞助
|
||||
RunInNewThread(Sub()
|
||||
Select Case Setup.Get("SystemLaunchCount")
|
||||
Case 20, 50, 100, 150, 200, 250, 300, 350, 400, 450, 500, 600, 700, 800, 900, 1000, 1100, 1200, 1300, 1400, 1500, 1700, 1900, 2100, 2300, 2500
|
||||
If MyMsgBox("PCL 已经为你启动了 " & Setup.Get("SystemLaunchCount") & " 次游戏啦!" & vbCrLf &
|
||||
"如果觉得 PCL 还算好用的话,也可以考虑赞助一下作者……一点心意也行……" & vbCrLf &
|
||||
"毕竟一个人开发也不容易(悲)……",
|
||||
"求赞助啦……", "这就赞助!", "但是我拒绝") = 1 Then
|
||||
OpenWebsite("https://afdian.net/a/LTCat")
|
||||
End If
|
||||
End Select
|
||||
End Sub, "Donate")
|
||||
RunInNewThread(
|
||||
Sub()
|
||||
Select Case Setup.Get("SystemLaunchCount")
|
||||
Case 10, 20, 40, 60, 80, 100, 120, 150, 200, 250, 300, 350, 400, 500, 600, 700, 800, 900, 1000, 1200, 1400, 1600, 1800, 2000
|
||||
If MyMsgBox("PCL 已经为你启动了 " & Setup.Get("SystemLaunchCount") & " 次游戏啦!" & vbCrLf &
|
||||
"如果 PCL 还算好用的话,能不能考虑赞助一下 PCL……" & vbCrLf &
|
||||
"如果没有大家的支持,PCL 很难在免费、无任何广告的情况下维持数年的更新(磕头)……!",
|
||||
Setup.Get("SystemLaunchCount") & " 次启动!", "支持 PCL!", "但是我拒绝") = 1 Then
|
||||
OpenWebsite("https://afdian.com/a/LTCat")
|
||||
End If
|
||||
End Select
|
||||
End Sub, "Donate")
|
||||
#End If
|
||||
'正版购买提示
|
||||
If Not Setup.Get("HintBuy") AndAlso Setup.Get("LoginType") <> McLoginType.Ms Then
|
||||
Select Case Setup.Get("SystemLaunchCount")
|
||||
Case 10, 35, 75, 125, 175, 225, 275, 325, 375, 425, 475, 550, 650, 750, 850, 950, 1050, 1150, 1250, 1350, 1450, 1600, 1800, 2000, 2200, 2400
|
||||
If MyMsgBox("你已经启动了 " & Setup.Get("SystemLaunchCount") & " 次 Minecraft 啦!" & vbCrLf &
|
||||
"如果觉得 Minecraft 还不错,也可以考虑购买正版支持一下,毕竟开发游戏也很不容易……" & vbCrLf &
|
||||
"在你登录一次正版账号后,就不会再出现这个提示了。",
|
||||
"考虑一下正版?", "购买正版游戏", "下次一定") = 1 Then
|
||||
OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj")
|
||||
End If
|
||||
End Select
|
||||
If IsSystemLanguageChinese() Then
|
||||
RunInNewThread(
|
||||
Sub()
|
||||
Select Case Setup.Get("SystemLaunchCount")
|
||||
Case 3, 8, 15, 30, 50, 70, 90, 110, 130, 180, 220, 280, 330, 380, 450, 550, 660, 750, 880, 950, 1100, 1300, 1500, 1700, 1900
|
||||
If MyMsgBox("你已经启动了 " & Setup.Get("SystemLaunchCount") & " 次 Minecraft 啦!" & vbCrLf &
|
||||
"如果觉得 Minecraft 还不错,可以购买正版支持一下,毕竟开发游戏也真的很不容易……不要一直白嫖啦。" & vbCrLf & vbCrLf &
|
||||
"在登录一次正版账号后,就不会再出现这个提示了!",
|
||||
"考虑一下正版?", "支持正版游戏!", "下次一定") = 1 Then
|
||||
OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj")
|
||||
End If
|
||||
End Select
|
||||
End Sub, "Buy Minecraft")
|
||||
ElseIf Setup.Get("LoginType") = McLoginType.Legacy Then
|
||||
Select Case MyMsgBox("你必须先登录正版账号,才能进行离线登录!", "正版验证", "购买正版", "试玩", "返回",
|
||||
Button1Action:=Sub() OpenWebsite("https://www.xbox.com/zh-cn/games/store/minecraft-java-bedrock-edition-for-pc/9nxp44l49shj"))
|
||||
Case 2
|
||||
Hint("游戏将以试玩模式启动!", HintType.Critical)
|
||||
CurrentLaunchOptions.ExtraArgs.Add("--demo")
|
||||
Case 3
|
||||
Throw New Exception("$$")
|
||||
End Select
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
|
||||
@@ -364,19 +381,19 @@ NextInner:
|
||||
'根据当前登录方式优先返回
|
||||
Select Case Setup.Get("LoginType")
|
||||
Case McLoginType.Ms
|
||||
If Setup.Get("CacheMsName") <> "" Then Return Setup.Get("CacheMsName")
|
||||
If Setup.Get("CacheMsV2Name") <> "" Then Return Setup.Get("CacheMsV2Name")
|
||||
Case McLoginType.Legacy
|
||||
If Setup.Get("LoginLegacyName") <> "" Then Return Setup.Get("LoginLegacyName").ToString.Before("¨")
|
||||
If Setup.Get("LoginLegacyName") <> "" Then Return Setup.Get("LoginLegacyName").ToString.BeforeFirst("¨")
|
||||
Case McLoginType.Nide
|
||||
If Setup.Get("CacheNideName") <> "" Then Return Setup.Get("CacheNideName")
|
||||
Case McLoginType.Auth
|
||||
If Setup.Get("CacheAuthName") <> "" Then Return Setup.Get("CacheAuthName")
|
||||
End Select
|
||||
'查找所有可能的项
|
||||
If Setup.Get("CacheMsName") <> "" Then Return Setup.Get("CacheMsName")
|
||||
If Setup.Get("CacheMsV2Name") <> "" Then Return Setup.Get("CacheMsV2Name")
|
||||
If Setup.Get("CacheNideName") <> "" Then Return Setup.Get("CacheNideName")
|
||||
If Setup.Get("CacheAuthName") <> "" Then Return Setup.Get("CacheAuthName")
|
||||
If Setup.Get("LoginLegacyName") <> "" Then Return Setup.Get("LoginLegacyName").ToString.Before("¨")
|
||||
If Setup.Get("LoginLegacyName") <> "" Then Return Setup.Get("LoginLegacyName").ToString.BeforeFirst("¨")
|
||||
Return Nothing
|
||||
End Function
|
||||
''' <summary>
|
||||
@@ -385,7 +402,7 @@ NextInner:
|
||||
Public Function McLoginAble() As String
|
||||
Select Case Setup.Get("LoginType")
|
||||
Case McLoginType.Ms
|
||||
If Setup.Get("CacheMsOAuthRefresh") = "" Then
|
||||
If Setup.Get("CacheMsV2OAuthRefresh") = "" Then
|
||||
Return FrmLoginMs.IsVaild()
|
||||
Else
|
||||
Return ""
|
||||
@@ -436,7 +453,7 @@ NextInner:
|
||||
Case McLoginType.Legacy
|
||||
LoginData = PageLoginLegacy.GetLoginData()
|
||||
Case McLoginType.Ms
|
||||
If Setup.Get("CacheMsOAuthRefresh") = "" Then
|
||||
If Setup.Get("CacheMsV2OAuthRefresh") = "" Then
|
||||
LoginData = PageLoginMs.GetLoginData()
|
||||
Else
|
||||
LoginData = PageLoginMsSkin.GetLoginData()
|
||||
@@ -487,19 +504,22 @@ NextInner:
|
||||
#Region "分方式登录模块"
|
||||
|
||||
'各个登录方式的主对象与输入构造
|
||||
Public McLoginMsLoader As New LoaderTask(Of McLoginMs, McLoginResult)("Loader Login Ms", AddressOf McLoginMsStart) With {.ReloadTimeout = 300000}
|
||||
Public McLoginMsLoader As New LoaderTask(Of McLoginMs, McLoginResult)("Loader Login Ms", AddressOf McLoginMsStart) With {.ReloadTimeout = 1}
|
||||
Public McLoginLegacyLoader As New LoaderTask(Of McLoginLegacy, McLoginResult)("Loader Login Legacy", AddressOf McLoginLegacyStart)
|
||||
Public McLoginNideLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Nide", AddressOf McLoginServerStart) With {.ReloadTimeout = 60000}
|
||||
Public McLoginAuthLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Auth", AddressOf McLoginServerStart) With {.ReloadTimeout = 60000}
|
||||
Public McLoginNideLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Nide", AddressOf McLoginServerStart) With {.ReloadTimeout = 1000 * 60 * 10}
|
||||
Public McLoginAuthLoader As New LoaderTask(Of McLoginServer, McLoginResult)("Loader Login Auth", AddressOf McLoginServerStart) With {.ReloadTimeout = 1000 * 60 * 10}
|
||||
|
||||
'主加载函数,返回所有需要的登录信息
|
||||
Private McLoginMsRefreshTime As Long = 0 '上次刷新登录的时间
|
||||
Private Sub McLoginMsStart(Data As LoaderTask(Of McLoginMs, McLoginResult))
|
||||
Dim Input As McLoginMs = Data.Input
|
||||
Dim LogUsername As String = Input.UserName
|
||||
McLaunchLog("登录方式:正版(" & If(LogUsername = "", "尚未登录", LogUsername) & ")")
|
||||
Data.Progress = 0.05
|
||||
'检查是否已经登录完成
|
||||
If Input.AccessToken <> "" AndAlso Not Data.IsForceRestarting Then
|
||||
If Not Data.IsForceRestarting AndAlso '不要求强行重启
|
||||
Input.AccessToken <> "" AndAlso '已经登录过了
|
||||
(McLoginMsRefreshTime > 0 AndAlso GetTimeTick() - McLoginMsRefreshTime < 1000 * 60 * 10) Then '完成时间在 10 分钟内
|
||||
Data.Output = New McLoginResult With
|
||||
{.AccessToken = Input.AccessToken, .Name = Input.UserName, .Uuid = Input.Uuid, .Type = "Microsoft", .ClientToken = Input.Uuid, .ProfileJson = Input.ProfileJson}
|
||||
GoTo SkipLogin
|
||||
@@ -509,49 +529,47 @@ NextInner:
|
||||
If Input.OAuthRefreshToken = "" Then
|
||||
'无 RefreshToken
|
||||
Relogin:
|
||||
Dim OAuthCode As String = MsLoginStep1(Data)
|
||||
If Data.IsAborted Then Throw New ThreadInterruptedException
|
||||
Data.Progress = 0.2
|
||||
OAuthTokens = MsLoginStep2(OAuthCode, False)
|
||||
OAuthTokens = MsLoginStep1New(Data)
|
||||
Else
|
||||
'有 RefreshToken
|
||||
OAuthTokens = MsLoginStep2(Input.OAuthRefreshToken, True)
|
||||
OAuthTokens = MsLoginStep1Refresh(Input.OAuthRefreshToken)
|
||||
If OAuthTokens(0) = "Relogin" Then GoTo Relogin '要求重新打开登录网页认证
|
||||
End If
|
||||
'要求重新打开登录网页认证
|
||||
If OAuthTokens(0) = "Relogin" Then GoTo Relogin
|
||||
Data.Progress = 0.35
|
||||
If Data.IsAborted Then Throw New ThreadInterruptedException
|
||||
Data.Progress = 0.25
|
||||
If Data.IsAborted Then Throw New ThreadInterruptedException
|
||||
Dim OAuthAccessToken As String = OAuthTokens(0)
|
||||
Dim OAuthRefreshToken As String = OAuthTokens(1)
|
||||
Dim XBLToken As String = MsLoginStep3(OAuthAccessToken)
|
||||
Data.Progress = 0.5
|
||||
Dim XBLToken As String = MsLoginStep2(OAuthAccessToken)
|
||||
Data.Progress = 0.4
|
||||
If Data.IsAborted Then Throw New ThreadInterruptedException
|
||||
Dim Tokens = MsLoginStep4(XBLToken)
|
||||
Data.Progress = 0.65
|
||||
Dim Tokens = MsLoginStep3(XBLToken)
|
||||
Data.Progress = 0.55
|
||||
If Data.IsAborted Then Throw New ThreadInterruptedException
|
||||
Dim AccessToken As String = MsLoginStep5(Tokens)
|
||||
Data.Progress = 0.8
|
||||
Dim AccessToken As String = MsLoginStep4(Tokens)
|
||||
Data.Progress = 0.7
|
||||
If Data.IsAborted Then Throw New ThreadInterruptedException
|
||||
MsLoginStep6(AccessToken)
|
||||
Data.Progress = 0.9
|
||||
MsLoginStep5(AccessToken)
|
||||
Data.Progress = 0.85
|
||||
If Data.IsAborted Then Throw New ThreadInterruptedException
|
||||
Dim Result = MsLoginStep7(AccessToken)
|
||||
Dim Result = MsLoginStep6(AccessToken)
|
||||
Data.Progress = 0.98
|
||||
'输出登录结果
|
||||
Setup.Set("CacheMsOAuthRefresh", OAuthRefreshToken)
|
||||
Setup.Set("CacheMsAccess", AccessToken)
|
||||
Setup.Set("CacheMsUuid", Result(0))
|
||||
Setup.Set("CacheMsName", Result(1))
|
||||
Setup.Set("CacheMsProfileJson", Result(2))
|
||||
Setup.Set("CacheMsV2OAuthRefresh", OAuthRefreshToken)
|
||||
Setup.Set("CacheMsV2Access", AccessToken)
|
||||
Setup.Set("CacheMsV2Uuid", Result(0))
|
||||
Setup.Set("CacheMsV2Name", Result(1))
|
||||
Setup.Set("CacheMsV2ProfileJson", Result(2))
|
||||
Dim MsJson As JObject = GetJson(Setup.Get("LoginMsJson"))
|
||||
MsJson.Remove(Input.UserName) '如果更改了玩家名……
|
||||
MsJson(Result(1)) = OAuthRefreshToken
|
||||
Setup.Set("LoginMsJson", MsJson.ToString(Newtonsoft.Json.Formatting.None))
|
||||
Data.Output = New McLoginResult With {.AccessToken = AccessToken, .Name = Result(1), .Uuid = Result(0), .Type = "Microsoft", .ClientToken = Result(0), .ProfileJson = Result(2)}
|
||||
'解锁主题
|
||||
SkipLogin:
|
||||
'结束
|
||||
McLoginMsRefreshTime = GetTimeTick()
|
||||
McLaunchLog("微软登录完成")
|
||||
SkipLogin:
|
||||
Setup.Set("HintBuy", True) '关闭正版购买提示
|
||||
Data.Progress = 0.98
|
||||
If ThemeUnlock(10, False) Then MyMsgBox("感谢你对正版游戏的支持!" & vbCrLf & "隐藏主题 跳票红 已解锁!", "提示")
|
||||
End Sub
|
||||
Private Sub McLoginServerStart(Data As LoaderTask(Of McLoginServer, McLoginResult))
|
||||
@@ -668,6 +686,7 @@ LoginFinish:
|
||||
Url:=Data.Input.BaseUrl & "/validate",
|
||||
Method:="POST",
|
||||
Data:=RequestData.ToString(0),
|
||||
Headers:=New Dictionary(Of String, String) From {{"Accept-Language", "zh-CN"}},
|
||||
ContentType:="application/json; charset=utf-8") '没有返回值的
|
||||
'将登录结果输出
|
||||
Data.Output.AccessToken = AccessToken
|
||||
@@ -691,6 +710,7 @@ LoginFinish:
|
||||
""name"":""" & Setup.Get("Cache" & Data.Input.Token & "Name") & """},", "") & "
|
||||
""accessToken"":""" & Setup.Get("Cache" & Data.Input.Token & "Access") & """,
|
||||
""clientToken"":""" & Setup.Get("Cache" & Data.Input.Token & "Client") & """}",
|
||||
Headers:=New Dictionary(Of String, String) From {{"Accept-Language", "zh-CN"}},
|
||||
ContentType:="application/json; charset=utf-8"))
|
||||
'将登录结果输出
|
||||
If LoginJson("selectedProfile") Is Nothing Then Throw New Exception("选择的角色 " & Setup.Get("Cache" & Data.Input.Token & "Name") & " 无效!")
|
||||
@@ -721,6 +741,7 @@ LoginFinish:
|
||||
Url:=Data.Input.BaseUrl & "/authenticate",
|
||||
Method:="POST",
|
||||
Data:=RequestData.ToString(0),
|
||||
Headers:=New Dictionary(Of String, String) From {{"Accept-Language", "zh-CN"}},
|
||||
ContentType:="application/json; charset=utf-8"))
|
||||
'检查登录结果
|
||||
If LoginJson("availableProfiles").Count = 0 Then
|
||||
@@ -780,6 +801,28 @@ LoginFinish:
|
||||
Catch ex As Exception
|
||||
Dim AllMessage As String = GetExceptionSummary(ex)
|
||||
Log(ex, "登录失败原始错误信息", LogLevel.Normal)
|
||||
'读取服务器返回的错误
|
||||
If TypeOf ex Is ResponsedWebException Then
|
||||
Dim ErrorMessage As String = Nothing
|
||||
Try
|
||||
ErrorMessage = GetJson(DirectCast(ex, ResponsedWebException).Response)("errorMessage")
|
||||
Catch
|
||||
End Try
|
||||
If Not String.IsNullOrWhiteSpace(ErrorMessage) Then
|
||||
If ErrorMessage.Contains("密码错误") OrElse ErrorMessage.ContainsF("Incorrect username or password", True) Then
|
||||
'密码错误,退出登录 (#5090)
|
||||
McLaunchLog("密码错误,退出登录")
|
||||
Select Case Data.Input.Type
|
||||
Case McLoginType.Auth
|
||||
RunInUi(AddressOf PageLoginAuthSkin.ExitLogin)
|
||||
Case McLoginType.Nide
|
||||
RunInUi(AddressOf PageLoginNideSkin.ExitLogin)
|
||||
End Select
|
||||
End If
|
||||
Throw New Exception("$登录失败:" & ErrorMessage)
|
||||
End If
|
||||
End If
|
||||
'通用关键字检测
|
||||
If AllMessage.Contains("403") Then
|
||||
Select Case Data.Input.Type
|
||||
Case McLoginType.Auth
|
||||
@@ -805,90 +848,48 @@ LoginFinish:
|
||||
End Try
|
||||
End Function
|
||||
|
||||
'微软登录步骤 1:打开网页认证,获取 OAuth Code
|
||||
Private Function MsLoginStep1(Data As LoaderTask(Of McLoginMs, McLoginResult)) As String
|
||||
McLaunchLog("开始微软登录步骤 1")
|
||||
If True OrElse OsVersion <= New Version(10, 0, 17763, 0) Then '由于 #3849,WebBrowser 已经无法正常加载微软登录网页了
|
||||
SystemBrowser:
|
||||
'Windows 7 或老版 Windows 10 登录
|
||||
OpenWebsite(FormLoginOAuth.LoginUrl1)
|
||||
Dim Result As String =
|
||||
MyMsgBoxInput("等待网页登录",
|
||||
"登录完成后,网页会变得完全空白,把那个空白网页的网址复制到下面的框中就行了!" & vbCrLf &
|
||||
"如果网络环境不佳,它可能一直加载不出来,那就只能试试用 VPN 或加速器了。",
|
||||
ValidateRules:=New ObjectModel.Collection(Of Validate) From {New ValidateRegex("(?<=code\=)[^&]+", "返回网址应以 https://login.live.com/oauth20_desktop.srf?code= 开头")},
|
||||
HintText:="https://login.live.com/oauth20_desktop.srf?code=XXXXXX")
|
||||
If Result Is Nothing Then
|
||||
McLaunchLog("微软登录已在步骤 1 被取消")
|
||||
Throw New ThreadInterruptedException("$$")
|
||||
'微软登录步骤 1,原始登录:获取 DeviceCode 并开启登录网页
|
||||
Private Function MsLoginStep1New(Data As LoaderTask(Of McLoginMs, McLoginResult)) As String()
|
||||
'参考:https://learn.microsoft.com/zh-cn/entra/identity-platform/v2-oauth2-device-code
|
||||
|
||||
'初始请求
|
||||
Retry:
|
||||
McLaunchLog("开始微软登录步骤 1/6(原始登录)")
|
||||
Dim PrepareJson As JObject = GetJson(NetRequestRetry("https://login.microsoftonline.com/consumers/oauth2/v2.0/devicecode", "POST",
|
||||
$"client_id={OAuthClientId}&tenant=/consumers&scope=XboxLive.signin%20offline_access", "application/x-www-form-urlencoded"))
|
||||
McLaunchLog("网页登录地址:" & PrepareJson("verification_uri").ToString)
|
||||
|
||||
'弹窗
|
||||
Dim Converter As New MyMsgBoxConverter With {.Content = PrepareJson, .ForceWait = True, .Type = MyMsgBoxType.Login}
|
||||
WaitingMyMsgBox.Add(Converter)
|
||||
While Converter.Result Is Nothing
|
||||
Thread.Sleep(100)
|
||||
End While
|
||||
If TypeOf Converter.Result Is RestartException Then
|
||||
If MyMsgBox($"请在登录时选择 {vbLQ}其他登录方法{vbRQ},然后选择 {vbLQ}使用我的密码{vbRQ}。{vbCrLf}如果没有该选项,请选择 {vbLQ}设置密码{vbRQ},设置完毕后再登录。",
|
||||
"需要使用密码登录", "重新登录", "设置密码", "取消",
|
||||
Button2Action:=Sub() OpenWebsite("https://account.live.com/password/Change")) = 1 Then
|
||||
GoTo Retry
|
||||
Else
|
||||
Return RegexSeek(Result, "(?<=code\=)[^&]+")
|
||||
Throw New Exception("$$")
|
||||
End If
|
||||
Hint("网页登录成功,你可以关闭浏览器啦!", HintType.Finish)
|
||||
ElseIf TypeOf Converter.Result Is Exception Then
|
||||
Throw CType(Converter.Result, Exception)
|
||||
Else
|
||||
'Windows 10 登录
|
||||
Dim ReturnCode As String = Nothing
|
||||
Dim ReturnEx As Exception = Nothing
|
||||
Dim IsFinished As LoadState = LoadState.Loading
|
||||
Dim LoginForm As FormLoginOAuth = Nothing
|
||||
Dim IsSwitchToSystemBrowser As Boolean = False
|
||||
RunInUi(Sub()
|
||||
Try
|
||||
LoginForm = New FormLoginOAuth
|
||||
LoginForm.Show()
|
||||
AddHandler LoginForm.OnLoginSuccess, Sub(Code As String)
|
||||
ReturnCode = Code
|
||||
IsFinished = LoadState.Finished
|
||||
End Sub
|
||||
AddHandler LoginForm.OnLoginCanceled, Sub(IsSwitch As Boolean)
|
||||
IsFinished = LoadState.Aborted
|
||||
IsSwitchToSystemBrowser = IsSwitch
|
||||
End Sub
|
||||
Catch ex As Exception
|
||||
ReturnEx = ex
|
||||
IsFinished = LoadState.Failed
|
||||
End Try
|
||||
End Sub)
|
||||
Do While IsFinished = LoadState.Loading AndAlso Not Data.IsAborted
|
||||
Thread.Sleep(20)
|
||||
Loop
|
||||
RunInUi(Sub() If LoginForm IsNot Nothing Then LoginForm.Close())
|
||||
If IsFinished = LoadState.Finished Then
|
||||
Return ReturnCode
|
||||
ElseIf IsFinished = LoadState.Failed Then
|
||||
Throw ReturnEx
|
||||
ElseIf IsSwitchToSystemBrowser Then
|
||||
McLaunchLog("微软登录在步骤 1 要求切换到系统浏览器")
|
||||
GoTo SystemBrowser
|
||||
Else
|
||||
McLaunchLog("微软登录已在步骤 1 被取消")
|
||||
Throw New ThreadInterruptedException("$$")
|
||||
End If
|
||||
Return Converter.Result
|
||||
End If
|
||||
End Function
|
||||
'微软登录步骤 2:从 OAuth Code 或 OAuth RefreshToken 获取 {OAuth AccessToken, OAuth RefreshToken}
|
||||
Private Function MsLoginStep2(Code As String, IsRefresh As Boolean) As String()
|
||||
McLaunchLog("开始微软登录步骤 2(" & If(IsRefresh, "", "非") & "刷新登录)")
|
||||
'微软登录步骤 1,刷新登录:从 OAuth Code 或 OAuth RefreshToken 获取 {OAuth AccessToken, OAuth RefreshToken}
|
||||
Private Function MsLoginStep1Refresh(Code As String) As String()
|
||||
McLaunchLog("开始微软登录步骤 1/6(刷新登录)")
|
||||
|
||||
Dim Request As String
|
||||
If IsRefresh Then
|
||||
Request = "client_id=00000000402b5328" & "&" &
|
||||
"refresh_token=" & Uri.EscapeDataString(Code) & "&" &
|
||||
"grant_type=refresh_token" & "&" &
|
||||
"redirect_uri=" & Uri.EscapeDataString("https://login.live.com/oauth20_desktop.srf") & "&" &
|
||||
"scope=" & Uri.EscapeDataString("service::user.auth.xboxlive.com::MBI_SSL")
|
||||
Else
|
||||
Request = "client_id=00000000402b5328" & "&" &
|
||||
"code=" & Uri.EscapeDataString(Code) & "&" &
|
||||
"grant_type=authorization_code" & "&" &
|
||||
"redirect_uri=" & Uri.EscapeDataString("https://login.live.com/oauth20_desktop.srf") & "&" &
|
||||
"scope=" & Uri.EscapeDataString("service::user.auth.xboxlive.com::MBI_SSL")
|
||||
End If
|
||||
Dim Result As String
|
||||
Try
|
||||
Result = NetRequestMulty("https://login.live.com/oauth20_token.srf", "POST", Request, "application/x-www-form-urlencoded", 2)
|
||||
Result = NetRequestMultiple("https://login.live.com/oauth20_token.srf", "POST",
|
||||
$"client_id={OAuthClientId}&refresh_token={Uri.EscapeDataString(Code)}&grant_type=refresh_token&scope=XboxLive.signin%20offline_access",
|
||||
"application/x-www-form-urlencoded", 2)
|
||||
Catch ex As Exception
|
||||
If ex.Message.Contains("must sign in again") OrElse ex.Message.Contains("invalid_grant") Then '#269
|
||||
If ex.Message.Contains("must sign in again") OrElse (ex.Message.Contains("refresh_token") AndAlso ex.Message.Contains("is not valid")) Then '#269
|
||||
Return {"Relogin", ""}
|
||||
Else
|
||||
Throw
|
||||
@@ -900,28 +901,28 @@ SystemBrowser:
|
||||
Dim RefreshToken As String = ResultJson("refresh_token").ToString
|
||||
Return {AccessToken, RefreshToken}
|
||||
End Function
|
||||
'微软登录步骤 3:从 OAuth AccessToken 获取 XBLToken
|
||||
Private Function MsLoginStep3(AccessToken As String) As String
|
||||
McLaunchLog("开始微软登录步骤 3")
|
||||
'微软登录步骤 2:从 OAuth AccessToken 获取 XBLToken
|
||||
Private Function MsLoginStep2(AccessToken As String) As String
|
||||
McLaunchLog("开始微软登录步骤 2/6")
|
||||
|
||||
Dim Request As String = "{
|
||||
""Properties"": {
|
||||
""AuthMethod"": ""RPS"",
|
||||
""SiteName"": ""user.auth.xboxlive.com"",
|
||||
""RpsTicket"": """ & AccessToken & """
|
||||
},
|
||||
""RelyingParty"": ""http://auth.xboxlive.com"",
|
||||
""TokenType"": ""JWT""
|
||||
}"
|
||||
Dim Result As String = NetRequestMulty("https://user.auth.xboxlive.com/user/authenticate", "POST", Request, "application/json", 3)
|
||||
""Properties"": {
|
||||
""AuthMethod"": ""RPS"",
|
||||
""SiteName"": ""user.auth.xboxlive.com"",
|
||||
""RpsTicket"": """ & If(AccessToken.StartsWithF("d="), "", "d=") & AccessToken & """
|
||||
},
|
||||
""RelyingParty"": ""http://auth.xboxlive.com"",
|
||||
""TokenType"": ""JWT""
|
||||
}"
|
||||
Dim Result As String = NetRequestMultiple("https://user.auth.xboxlive.com/user/authenticate", "POST", Request, "application/json", 3)
|
||||
|
||||
Dim ResultJson As JObject = GetJson(Result)
|
||||
Dim XBLToken As String = ResultJson("Token").ToString
|
||||
Return XBLToken
|
||||
End Function
|
||||
'微软登录步骤 4:从 XBLToken 获取 {XSTSToken, UHS}
|
||||
Private Function MsLoginStep4(XBLToken As String) As String()
|
||||
McLaunchLog("开始微软登录步骤 4")
|
||||
'微软登录步骤 3:从 XBLToken 获取 {XSTSToken, UHS}
|
||||
Private Function MsLoginStep3(XBLToken As String) As String()
|
||||
McLaunchLog("开始微软登录步骤 3/6")
|
||||
|
||||
Dim Request As String = "{
|
||||
""Properties"": {
|
||||
@@ -935,7 +936,7 @@ SystemBrowser:
|
||||
}"
|
||||
Dim Result As String
|
||||
Try
|
||||
Result = NetRequestMulty("https://xsts.auth.xboxlive.com/xsts/authorize", "POST", Request, "application/json", 3)
|
||||
Result = NetRequestMultiple("https://xsts.auth.xboxlive.com/xsts/authorize", "POST", Request, "application/json", 3)
|
||||
Catch ex As Net.WebException
|
||||
'参考 https://github.com/PrismarineJS/prismarine-auth/blob/master/src/common/Constants.js
|
||||
If ex.Message.Contains("2148916227") Then
|
||||
@@ -971,14 +972,14 @@ SystemBrowser:
|
||||
Dim UHS As String = ResultJson("DisplayClaims")("xui")(0)("uhs").ToString
|
||||
Return {XSTSToken, UHS}
|
||||
End Function
|
||||
'微软登录步骤 5:从 {XSTSToken, UHS} 获取 Minecraft AccessToken
|
||||
Private Function MsLoginStep5(Tokens As String()) As String
|
||||
McLaunchLog("开始微软登录步骤 5")
|
||||
'微软登录步骤 4:从 {XSTSToken, UHS} 获取 Minecraft AccessToken
|
||||
Private Function MsLoginStep4(Tokens As String()) As String
|
||||
McLaunchLog("开始微软登录步骤 4/6")
|
||||
|
||||
Dim Request As String = New JObject(New JProperty("identityToken", $"XBL3.0 x={Tokens(1)};{Tokens(0)}")).ToString(0)
|
||||
Dim Result As String
|
||||
Try
|
||||
Result = NetRequestMulty("https://api.minecraftservices.com/authentication/login_with_xbox", "POST", Request, "application/json", 2)
|
||||
Result = NetRequestRetry("https://api.minecraftservices.com/authentication/login_with_xbox", "POST", Request, "application/json")
|
||||
Catch ex As Net.WebException
|
||||
Dim Message As String = GetExceptionSummary(ex)
|
||||
If Message.Contains("(429)") Then
|
||||
@@ -996,11 +997,11 @@ SystemBrowser:
|
||||
Dim AccessToken As String = ResultJson("access_token").ToString
|
||||
Return AccessToken
|
||||
End Function
|
||||
'微软登录步骤 6:验证微软账号是否持有 MC,这也会刷新 XGP
|
||||
Private Sub MsLoginStep6(AccessToken As String)
|
||||
McLaunchLog("开始微软登录步骤 6")
|
||||
'微软登录步骤 5:验证微软账号是否持有 MC,这也会刷新 XGP
|
||||
Private Sub MsLoginStep5(AccessToken As String)
|
||||
McLaunchLog("开始微软登录步骤 5/6")
|
||||
|
||||
Dim Result As String = NetRequestMulty("https://api.minecraftservices.com/entitlements/mcstore", "GET", "", "application/json", 2, New Dictionary(Of String, String) From {{"Authorization", "Bearer " & AccessToken}})
|
||||
Dim Result As String = NetRequestMultiple("https://api.minecraftservices.com/entitlements/mcstore", "GET", "", "application/json", 2, New Dictionary(Of String, String) From {{"Authorization", "Bearer " & AccessToken}})
|
||||
Try
|
||||
Dim ResultJson As JObject = GetJson(Result)
|
||||
If Not (ResultJson.ContainsKey("items") AndAlso ResultJson("items").Any) Then
|
||||
@@ -1015,13 +1016,13 @@ SystemBrowser:
|
||||
Throw
|
||||
End Try
|
||||
End Sub
|
||||
'微软登录步骤 7:从 Minecraft AccessToken 获取 {UUID, UserName, ProfileJson}
|
||||
Private Function MsLoginStep7(AccessToken As String) As String()
|
||||
McLaunchLog("开始微软登录步骤 7")
|
||||
'微软登录步骤 6:从 Minecraft AccessToken 获取 {UUID, UserName, ProfileJson}
|
||||
Private Function MsLoginStep6(AccessToken As String) As String()
|
||||
McLaunchLog("开始微软登录步骤 6/6")
|
||||
|
||||
Dim Result As String
|
||||
Try
|
||||
Result = NetRequestMulty("https://api.minecraftservices.com/minecraft/profile", "GET", "", "application/json", 2, New Dictionary(Of String, String) From {{"Authorization", "Bearer " & AccessToken}})
|
||||
Result = NetRequestMultiple("https://api.minecraftservices.com/minecraft/profile", "GET", "", "application/json", 2, New Dictionary(Of String, String) From {{"Authorization", "Bearer " & AccessToken}})
|
||||
Catch ex As Net.WebException
|
||||
Dim Message As String = GetExceptionSummary(ex)
|
||||
If Message.Contains("(429)") Then
|
||||
@@ -1069,7 +1070,7 @@ SystemBrowser:
|
||||
Case 3
|
||||
'使用正版用户名
|
||||
Try
|
||||
If Not SkinName = "" Then
|
||||
If SkinName <> "" AndAlso McVersionCurrent.Version.McCodeMain < 20 Then '1.20+ 或快照版不能使用该项(#3746)
|
||||
Log("[Skin] 由于离线皮肤设置,使用正版 UUID:" & SkinName)
|
||||
Uuid = McLoginMojangUuid(SkinName, False)
|
||||
End If
|
||||
@@ -1199,7 +1200,7 @@ SystemBrowser:
|
||||
'统一通行证检测
|
||||
If Setup.Get("LoginType") = McLoginType.Nide Then
|
||||
'至少 Java 8u101
|
||||
MinVer = If(New Version(1, 8, 0, 101) > MinVer, New Version(1, 8, 0, 101), MinVer)
|
||||
MinVer = If(New Version(1, 8, 0, 141) > MinVer, New Version(1, 8, 0, 141), MinVer)
|
||||
End If
|
||||
|
||||
SyncLock JavaLock
|
||||
@@ -1226,12 +1227,12 @@ SystemBrowser:
|
||||
ElseIf MaxVer < New Version(1, 8, 0, 0) Then
|
||||
JavaCode = 7
|
||||
If Not JavaDownloadConfirm("Java 7", True) Then Throw New Exception("$$")
|
||||
ElseIf MinVer > New Version(1, 8, 0, 100) AndAlso MaxVer < New Version(1, 8, 0, 321) Then
|
||||
JavaCode = "8u101"
|
||||
If Not JavaDownloadConfirm("Java 8.0.101 ~ 8.0.320", True) Then Throw New Exception("$$")
|
||||
ElseIf MinVer > New Version(1, 8, 0, 100) Then
|
||||
JavaCode = "8u101"
|
||||
If Not JavaDownloadConfirm("Java 8.0.101 或更高版本的 Java 8", True) Then 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("$$")
|
||||
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("$$")
|
||||
@@ -1276,44 +1277,36 @@ SystemBrowser:
|
||||
''' 释放 Java Wrapper 并返回完整文件路径。
|
||||
''' </summary>
|
||||
Public Function ExtractJavaWrapper() As String
|
||||
Dim BaseDir As String = GetJavaWrapperDir()
|
||||
Dim WrapperPath As String = BaseDir & "\JavaWrapper.jar"
|
||||
Dim WrapperPath As String = PathPure & "JavaWrapper.jar"
|
||||
Log("[Java] 选定的 Java Wrapper 路径:" & WrapperPath)
|
||||
SyncLock ExtractJavaWrapperLock '避免 OptiFine 和 Forge 安装时同时释放 Java Wrapper 导致冲突
|
||||
Dim IsWrapperWritten As Boolean = WriteFile(WrapperPath, GetResources("JavaWrapper"))
|
||||
If Not IsWrapperWritten AndAlso File.Exists(WrapperPath) Then
|
||||
'以下为 #4243 的修复,因为未知原因 Java Wrapper 可能变为只读文件
|
||||
Log("[Java] Java Wrapper 文件释放失败,但文件已存在,将在删除后尝试重新生成", LogLevel.Debug)
|
||||
Try
|
||||
File.Delete(WrapperPath)
|
||||
IsWrapperWritten = WriteFile(WrapperPath, GetResources("JavaWrapper"))
|
||||
Catch ex As Exception
|
||||
Log(ex, "Java Wrapper 文件重新释放失败,将尝试更换文件名重新生成")
|
||||
WrapperPath = BaseDir & "\JavaWrapper2.jar"
|
||||
IsWrapperWritten = WriteFile(WrapperPath, GetResources("JavaWrapper"))
|
||||
End Try
|
||||
End If
|
||||
If Not IsWrapperWritten Then Throw New FileNotFoundException("释放 Java Wrapper 失败,请查看 PCL 日志查找详细信息")
|
||||
Try
|
||||
WriteFile(WrapperPath, GetResources("JavaWrapper"))
|
||||
Catch ex As Exception
|
||||
If File.Exists(WrapperPath) Then
|
||||
'因为未知原因 Java Wrapper 可能变为只读文件(#4243)
|
||||
Log(ex, "Java Wrapper 文件释放失败,但文件已存在,将在删除后尝试重新生成", LogLevel.Developer)
|
||||
Try
|
||||
File.Delete(WrapperPath)
|
||||
WriteFile(WrapperPath, GetResources("JavaWrapper"))
|
||||
Catch ex2 As Exception
|
||||
Log(ex2, "Java Wrapper 文件重新释放失败,将尝试更换文件名重新生成", LogLevel.Developer)
|
||||
WrapperPath = PathPure & "JavaWrapper2.jar"
|
||||
Try
|
||||
WriteFile(WrapperPath, GetResources("JavaWrapper"))
|
||||
Catch ex3 As Exception
|
||||
Throw New FileNotFoundException("释放 Java Wrapper 最终尝试失败", ex3)
|
||||
End Try
|
||||
End Try
|
||||
Else
|
||||
Throw New FileNotFoundException("释放 Java Wrapper 失败", ex)
|
||||
End If
|
||||
End Try
|
||||
End SyncLock
|
||||
Return WrapperPath
|
||||
End Function
|
||||
Private ExtractJavaWrapperLock As New Object
|
||||
|
||||
''' <summary>
|
||||
''' 获取 Java Wrapper 所在的文件夹,不以 \ 结尾。
|
||||
''' </summary>
|
||||
Public Function GetJavaWrapperDir() As String
|
||||
If (Path & "PCL").IsASCII() Then
|
||||
Return Path & "PCL"
|
||||
ElseIf PathAppdata.IsASCII() Then
|
||||
Return PathAppdata.TrimEnd("\")
|
||||
ElseIf PathTemp.IsASCII() Then
|
||||
Return PathTemp.TrimEnd("\")
|
||||
Else
|
||||
Return OsDrive & "ProgramData\PCL"
|
||||
End If
|
||||
End Function
|
||||
|
||||
'主方法,合并 Jvm、Game、Replace 三部分的参数数据
|
||||
Private Sub McLaunchArgumentMain(Loader As LoaderTask(Of String, List(Of McLibToken)))
|
||||
McLaunchLog("开始获取 Minecraft 启动参数")
|
||||
@@ -1354,8 +1347,12 @@ SystemBrowser:
|
||||
Arguments = Arguments.Replace(" -Dos.name=Windows 10", " -Dos.name=""Windows 10""")
|
||||
'全屏
|
||||
If Setup.Get("LaunchArgumentWindowType") = 0 Then Arguments += " --fullscreen"
|
||||
'由 Option 传入的额外参数
|
||||
For Each Arg In CurrentLaunchOptions.ExtraArgs
|
||||
Arguments += " " & Arg.Trim
|
||||
Next
|
||||
'进服
|
||||
Dim Server As String = If(String.IsNullOrEmpty(McLaunchLoader.Input.ServerIp), Setup.Get("VersionServerEnter", McVersionCurrent), McLaunchLoader.Input.ServerIp)
|
||||
Dim Server As String = If(String.IsNullOrEmpty(CurrentLaunchOptions.ServerIp), Setup.Get("VersionServerEnter", McVersionCurrent), CurrentLaunchOptions.ServerIp)
|
||||
If Server.Length > 0 Then
|
||||
If McVersionCurrent.ReleaseTime > New Date(2023, 4, 4) Then
|
||||
'QuickPlay
|
||||
@@ -1409,7 +1406,7 @@ SystemBrowser:
|
||||
Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent))
|
||||
Try
|
||||
Dim Response As String = NetGetCodeByRequestRetry(Server, Encoding.UTF8)
|
||||
DataList.Insert(0, "-javaagent:""" & PathAppdata & "authlib-injector.jar""=" & Server &
|
||||
DataList.Insert(0, "-javaagent:""" & PathPure & "authlib-injector.jar""=" & Server &
|
||||
" -Dauthlibinjector.side=client" &
|
||||
" -Dauthlibinjector.yggdrasil.prefetched=" & Convert.ToBase64String(Encoding.UTF8.GetBytes(Response)))
|
||||
Catch ex As Exception
|
||||
@@ -1419,7 +1416,7 @@ SystemBrowser:
|
||||
|
||||
'添加 Java Wrapper 作为主 Jar
|
||||
If McLaunchJavaSelected.VersionCode >= 9 Then DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
|
||||
DataList.Add("-Doolloo.jlw.tmpdir=""" & GetJavaWrapperDir() & """")
|
||||
DataList.Add("-Doolloo.jlw.tmpdir=""" & PathPure.TrimEnd("\") & """")
|
||||
DataList.Add("-jar """ & ExtractJavaWrapper() & """")
|
||||
|
||||
'添加 MainClass
|
||||
@@ -1476,7 +1473,7 @@ NextVersion:
|
||||
Setup.Get("VersionServerAuthServer", Version:=McVersionCurrent))
|
||||
Try
|
||||
Dim Response As String = NetGetCodeByRequestRetry(Server, Encoding.UTF8)
|
||||
DataList.Insert(0, "-javaagent:""" & PathAppdata & "authlib-injector.jar""=" & Server &
|
||||
DataList.Insert(0, "-javaagent:""" & PathPure & "authlib-injector.jar""=" & Server &
|
||||
" -Dauthlibinjector.side=client" &
|
||||
" -Dauthlibinjector.yggdrasil.prefetched=" & Convert.ToBase64String(Encoding.UTF8.GetBytes(Response)))
|
||||
Catch ex As Exception
|
||||
@@ -1486,7 +1483,7 @@ NextVersion:
|
||||
|
||||
'添加 Java Wrapper 作为主 Jar
|
||||
If McLaunchJavaSelected.VersionCode >= 9 Then DataList.Add("--add-exports cpw.mods.bootstraplauncher/cpw.mods.bootstraplauncher=ALL-UNNAMED")
|
||||
DataList.Add("-Doolloo.jlw.tmpdir=""" & GetJavaWrapperDir() & """")
|
||||
DataList.Add("-Doolloo.jlw.tmpdir=""" & PathPure.TrimEnd("\") & """")
|
||||
DataList.Add("-jar """ & ExtractJavaWrapper() & """")
|
||||
|
||||
'将 "-XXX" 与后面 "XXX" 合并到一起
|
||||
@@ -1661,8 +1658,11 @@ NextVersion:
|
||||
GameSize = New Size(875 - 2, 540 - 2)
|
||||
End Select
|
||||
GameSize.Height -= 29.5 * DPI / 96 '标题栏高度
|
||||
If McVersionCurrent.Version.McCodeMain <= 12 AndAlso McLaunchJavaSelected.VersionCode <= 8 AndAlso
|
||||
Not McVersionCurrent.Version.HasOptiFine AndAlso Not McVersionCurrent.Version.HasForge Then '修复 #3463:1.12.2-,JRE 8 下窗口大小为设置大小的 DPI% 倍
|
||||
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% 倍
|
||||
McLaunchLog($"已应用窗口大小过大修复({McLaunchJavaSelected.Version.Revision})")
|
||||
GameSize.Width /= DPI / 96
|
||||
GameSize.Height /= DPI / 96
|
||||
End If
|
||||
@@ -1785,7 +1785,6 @@ NextVersion:
|
||||
{
|
||||
""authenticationDatabase"": {
|
||||
""00000111112222233333444445555566"": {
|
||||
""accessToken"": """ & McLoginLoader.Output.AccessToken & """,
|
||||
""username"": """ & McLoginLoader.Output.Name.Replace("""", "-") & """,
|
||||
""profiles"": {
|
||||
""66666555554444433333222221111100"": {
|
||||
@@ -1816,7 +1815,6 @@ NextVersion:
|
||||
{
|
||||
""authenticationDatabase"": {
|
||||
""00000111112222233333444445555566"": {
|
||||
""accessToken"": """ & McLoginLoader.Output.AccessToken & """,
|
||||
""username"": """ & McLoginLoader.Output.Name.Replace("""", "-") & """,
|
||||
""profiles"": {
|
||||
""66666555554444433333222221111100"": {
|
||||
@@ -1892,16 +1890,12 @@ NextVersion:
|
||||
End Try
|
||||
|
||||
'离线皮肤 Alex 警告
|
||||
Try
|
||||
If McVersionCurrent.Version.McCodeMain <= 7 AndAlso McVersionCurrent.Version.McCodeMain >= 2 AndAlso '1.7 ~ 1.2
|
||||
If McVersionCurrent.Version.McCodeMain <= 7 AndAlso McVersionCurrent.Version.McCodeMain >= 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 皮肤
|
||||
Hint("此 Minecraft 版本尚不支持 Alex 皮肤,你的皮肤可能会显示为 Steve!", HintType.Critical)
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Log(ex, "检查离线皮肤失效失败")
|
||||
End Try
|
||||
Hint("此 Minecraft 版本尚不支持 Alex 皮肤,你的皮肤可能会显示为 Steve!", HintType.Critical)
|
||||
End If
|
||||
|
||||
'离线皮肤资源包
|
||||
Try
|
||||
@@ -2054,25 +2048,25 @@ IgnoreCustomSkin:
|
||||
"@echo off" & vbCrLf &
|
||||
"title 启动 - " & McVersionCurrent.Name & vbCrLf &
|
||||
"echo 游戏正在启动,请稍候。" & vbCrLf &
|
||||
"set APPDATA=""" & PathMcFolder & """" & vbCrLf &
|
||||
"cd /D """ & PathMcFolder & """" & vbCrLf &
|
||||
"set APPDATA=""" & McVersionCurrent.PathIndie & """" & vbCrLf &
|
||||
"cd /D """ & McVersionCurrent.PathIndie & """" & vbCrLf &
|
||||
CustomCommandGlobal & vbCrLf &
|
||||
CustomCommandVersion & vbCrLf &
|
||||
"""" & McLaunchJavaSelected.PathJava & """ " & McLaunchArgument & vbCrLf &
|
||||
"echo 游戏已退出。" & vbCrLf &
|
||||
"pause"
|
||||
WriteFile(If(McLaunchLoader.Input.SaveBatch, Path & "PCL\LatestLaunch.bat"), SecretFilter(CmdString, "F"),
|
||||
WriteFile(If(CurrentLaunchOptions.SaveBatch, Path & "PCL\LatestLaunch.bat"), SecretFilter(CmdString, "F"),
|
||||
Encoding:=If(Encoding.Default.Equals(Encoding.UTF8), Encoding.UTF8, Encoding.GetEncoding("GB18030")))
|
||||
If McLaunchLoader.Input.SaveBatch IsNot Nothing Then
|
||||
If CurrentLaunchOptions.SaveBatch IsNot Nothing Then
|
||||
McLaunchLog("导出启动脚本完成,强制结束启动过程")
|
||||
AbortHint = "导出启动脚本成功!"
|
||||
OpenExplorer("/select,""" & McLaunchLoader.Input.SaveBatch & """")
|
||||
OpenExplorer("/select,""" & CurrentLaunchOptions.SaveBatch & """")
|
||||
Loader.Parent.Abort()
|
||||
Exit Sub '导出脚本完成
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Log(ex, "输出启动脚本失败")
|
||||
If McLaunchLoader.Input.SaveBatch IsNot Nothing Then Throw ex '直接触发启动失败
|
||||
If CurrentLaunchOptions.SaveBatch IsNot Nothing Then Throw ex '直接触发启动失败
|
||||
End Try
|
||||
|
||||
'执行自定义命令
|
||||
@@ -2143,6 +2137,8 @@ IgnoreCustomSkin:
|
||||
StartInfo.EnvironmentVariables("Path") = Join(Paths.Distinct.ToList, ";")
|
||||
|
||||
'设置其他参数
|
||||
StartInfo.StandardErrorEncoding = Encoding.UTF8
|
||||
StartInfo.StandardOutputEncoding = Encoding.UTF8
|
||||
StartInfo.WorkingDirectory = McVersionCurrent.PathIndie
|
||||
StartInfo.UseShellExecute = False
|
||||
StartInfo.RedirectStandardOutput = True
|
||||
|
||||
@@ -85,7 +85,7 @@ Public Module ModMinecraft
|
||||
Next
|
||||
If Not Renamed Then CacheMcFolderList.Add(New McFolder With {.Name = Name, .Path = Path, .Type = McFolderType.Custom})
|
||||
Else
|
||||
Hint("无效的 Minecraft 文件夹:" & Path, HintType.Critical)
|
||||
Hint("无法访问 Minecraft 文件夹:" & Path, HintType.Critical)
|
||||
End If
|
||||
Next
|
||||
|
||||
@@ -475,22 +475,27 @@ VersionSearchFinish:
|
||||
''' </summary>
|
||||
Public Property JsonText As String
|
||||
Get
|
||||
'快速检查 JSON 是否以 { 开头、} 结尾;忽略空白字符
|
||||
Dim FastJsonCheck =
|
||||
Function(Json As String) As Boolean
|
||||
Dim TrimedJson As String = Json.Trim()
|
||||
Return TrimedJson.StartsWithF("{") AndAlso TrimedJson.EndsWithF("}")
|
||||
End Function
|
||||
If _JsonText Is Nothing Then
|
||||
If Not File.Exists(Path & Name & ".json") Then Throw New Exception("未找到版本 json 文件:" & Path & Name & ".json")
|
||||
If Not File.Exists(Path & Name & ".json") Then Throw New Exception($"未找到版本 JSON 文件:{Path}{Name}.json")
|
||||
_JsonText = ReadFile(Path & Name & ".json")
|
||||
'如果 ReadFile 失败会返回空字符串;这可能是由于文件被临时占用,故延时后重试
|
||||
If _JsonText.Length = 0 Then
|
||||
If Not FastJsonCheck(_JsonText) Then
|
||||
If RunInUi() Then
|
||||
Log("[Minecraft] 版本 json 文件为空或读取失败,由于代码在主线程运行,将不再进行重试", LogLevel.Debug)
|
||||
Throw New Exception("版本 Json 文件为空或读取失败")
|
||||
Log("[Minecraft] 版本 JSON 文件为空或有误,由于代码在主线程运行,将不再进行重试", LogLevel.Debug)
|
||||
GetJson(_JsonText) '触发异常
|
||||
Else
|
||||
Log("[Minecraft] 版本 json 文件为空或读取失败,将在 2s 后重试读取(" & Path & Name & ".json)", LogLevel.Debug)
|
||||
Log("[Minecraft] 版本 JSON 文件为空或有误,将在 2s 后重试读取(" & Path & Name & ".json)", LogLevel.Debug)
|
||||
Thread.Sleep(2000)
|
||||
_JsonText = ReadFile(Path & Name & ".json")
|
||||
If _JsonText.Length = 0 Then Throw New Exception("版本 json 文件为空或读取失败")
|
||||
If Not FastJsonCheck(_JsonText) Then GetJson(_JsonText) '触发异常
|
||||
End If
|
||||
End If
|
||||
If _JsonText.Length < 100 Then Throw New Exception("版本 json 文件有误,内容为:" & _JsonText)
|
||||
End If
|
||||
Return _JsonText
|
||||
End Get
|
||||
@@ -562,10 +567,10 @@ Recheck:
|
||||
GoTo Recheck
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Log(ex, "合并版本依赖项 json 失败(" & If(InheritVersion, "null").ToString & ")")
|
||||
Log(ex, "合并版本依赖项 JSON 失败(" & If(InheritVersion, "null").ToString & ")")
|
||||
End Try
|
||||
Catch ex As Exception
|
||||
Throw New Exception("版本 json 不规范(" & If(Name, "null") & ")", ex)
|
||||
Throw New Exception("初始化版本 JSON 时失败(" & If(Name, "null") & ")", ex)
|
||||
End Try
|
||||
Try
|
||||
'处理 JumpLoader
|
||||
@@ -665,7 +670,7 @@ Recheck:
|
||||
Try
|
||||
Dim JsonObjCheck = JsonObject
|
||||
Catch ex As Exception
|
||||
Log(ex, "版本 json 可用性检查失败(" & Path & ")")
|
||||
Log(ex, "版本 JSON 可用性检查失败(" & Path & ")")
|
||||
JsonText = ""
|
||||
JsonObject = Nothing
|
||||
Info = ex.Message
|
||||
@@ -1029,21 +1034,21 @@ ExitDataLoad:
|
||||
Public Function GetMcFoolName(Name As String) As String
|
||||
Name = Name.ToLower
|
||||
If Name.StartsWithF("2.0") Then
|
||||
Return "这个秘密计划了两年的更新将游戏推向了一个新高度!"
|
||||
ElseIf Name.StartsWithF("20w14inf") OrElse Name = "20w14∞" Then
|
||||
Return "我们加入了 20 亿个新的维度,让无限的想象变成了现实!"
|
||||
Return "2013 | 这个秘密计划了两年的更新将游戏推向了一个新高度!"
|
||||
ElseIf Name = "15w14a" Then
|
||||
Return "作为一款全年龄向的游戏,我们需要和平,需要爱与拥抱。"
|
||||
Return "2015 | 作为一款全年龄向的游戏,我们需要和平,需要爱与拥抱。"
|
||||
ElseIf Name = "1.rv-pre1" Then
|
||||
Return "是时候将现代科技带入 Minecraft 了!"
|
||||
Return "2016 | 是时候将现代科技带入 Minecraft 了!"
|
||||
ElseIf Name = "3d shareware v1.34" Then
|
||||
Return "我们从地下室的废墟里找到了这个开发于 1994 年的杰作!"
|
||||
Return "2019 | 我们从地下室的废墟里找到了这个开发于 1994 年的杰作!"
|
||||
ElseIf Name.StartsWithF("20w14inf") OrElse Name = "20w14∞" Then
|
||||
Return "2020 | 我们加入了 20 亿个新的维度,让无限的想象变成了现实!"
|
||||
ElseIf Name = "22w13oneblockatatime" Then
|
||||
Return "一次一个方块更新!迎接全新的挖掘、合成与骑乘玩法吧!"
|
||||
Return "2022 | 一次一个方块更新!迎接全新的挖掘、合成与骑乘玩法吧!"
|
||||
ElseIf Name = "23w13a_or_b" Then
|
||||
Return "研究表明:玩家喜欢作出选择——越多越好!"
|
||||
Return "2023 | 研究表明:玩家喜欢作出选择——越多越好!"
|
||||
ElseIf Name = "24w14potato" Then
|
||||
Return "毒马铃薯一直都被大家忽视和低估,于是我们超级加强了它!"
|
||||
Return "2024 | 毒马铃薯一直都被大家忽视和低估,于是我们超级加强了它!"
|
||||
Else
|
||||
Return ""
|
||||
End If
|
||||
@@ -1251,9 +1256,8 @@ OnLoaded:
|
||||
Dim VersionList As New List(Of McVersion)
|
||||
|
||||
#Region "循环加载每个版本的信息"
|
||||
Dim Dirs As DirectoryInfo() = New DirectoryInfo(Path & "versions").GetDirectories
|
||||
For Each Folder As DirectoryInfo In Dirs
|
||||
If Not Folder.EnumerateFiles.Any Then
|
||||
For Each Folder As DirectoryInfo In New DirectoryInfo(Path & "versions").GetDirectories
|
||||
If Not Folder.Exists OrElse Not Folder.EnumerateFiles.Any Then
|
||||
Log("[Minecraft] 跳过空文件夹:" & Folder.FullName)
|
||||
Continue For
|
||||
End If
|
||||
@@ -1287,8 +1291,11 @@ OnLoaded:
|
||||
|
||||
'单独列出收藏的版本
|
||||
Dim StaredVersions As New List(Of McVersion)
|
||||
For Each Version As McVersion In VersionList
|
||||
If Version.IsStar AndAlso Not Version.DisplayType = McVersionCardType.Hidden Then StaredVersions.Add(Version)
|
||||
For Each Version As McVersion In VersionList.ToList
|
||||
If Version.IsStar AndAlso Not Version.DisplayType = McVersionCardType.Hidden Then
|
||||
StaredVersions.Add(Version)
|
||||
VersionList.Remove(Version)
|
||||
End If
|
||||
Next
|
||||
If StaredVersions.Any Then VersionListOriginal.Add(McVersionCardType.Star, StaredVersions)
|
||||
|
||||
@@ -1523,7 +1530,7 @@ OnLoaded:
|
||||
''' 要求玩家选择一个皮肤文件,并进行相关校验。
|
||||
''' </summary>
|
||||
Public Function McSkinSelect() As McSkinInfo
|
||||
Dim FileName As String = SelectFile("皮肤文件(*.png)|*.png", "选择皮肤文件")
|
||||
Dim FileName As String = SelectFile("皮肤文件(*.png;*.jpg;*.webp)|*.png;*.jpg;*.webp", "选择皮肤文件")
|
||||
|
||||
'验证有效性
|
||||
If FileName = "" Then Return New McSkinInfo With {.IsVaild = False}
|
||||
@@ -1930,7 +1937,7 @@ OnLoaded:
|
||||
''' <summary>
|
||||
''' 获取版本缺失的支持库文件所对应的 NetTaskFile。
|
||||
''' </summary>
|
||||
Public Function McLibFix(Version As McVersion, Optional CoreJarOnly As Boolean = False) As List(Of NetFile)
|
||||
Public Function McLibFix(Version As McVersion) As List(Of NetFile)
|
||||
If Not Version.IsLoaded Then Version.Load() '确保例如 JumpLoader 等项被合并入 Json
|
||||
Dim Result As New List(Of NetFile)
|
||||
|
||||
@@ -1943,91 +1950,103 @@ OnLoaded:
|
||||
Catch ex As Exception
|
||||
Log(ex, "版本缺失主 jar 文件所必须的信息", LogLevel.Developer)
|
||||
End Try
|
||||
If CoreJarOnly Then Return Result
|
||||
|
||||
'是否跳过校验
|
||||
Dim IsSetupSkip As Boolean = ShouldIgnoreFileCheck(Version)
|
||||
|
||||
'Library 文件
|
||||
Result.AddRange(McLibFixFromLibToken(McLibListGet(Version, False), JumpLoaderFolder:=Version.PathIndie & ".jumploader\", AllowUnsameFile:=IsSetupSkip))
|
||||
Result.AddRange(McLibFixFromLibToken(McLibListGet(Version, False), JumpLoaderFolder:=Version.PathIndie & ".jumploader\"))
|
||||
|
||||
'统一通行证文件
|
||||
If Setup.Get("VersionServerLogin", Version:=Version) = 3 Then
|
||||
Dim TargetFile = PathAppdata & "nide8auth.jar"
|
||||
If Not (IsSetupSkip AndAlso File.Exists(TargetFile)) Then
|
||||
Dim DownloadInfo As JObject = Nothing
|
||||
'获取下载信息
|
||||
Try
|
||||
Log("[Minecraft] 开始获取统一通行证下载信息")
|
||||
'测试链接:https://auth.mc-user.com:233/00000000000000000000000000000000/
|
||||
DownloadInfo = GetJson(NetGetCodeByDownload({
|
||||
Dim DownloadInfo As JObject = Nothing
|
||||
'获取下载信息
|
||||
Try
|
||||
Log("[Minecraft] 开始获取统一通行证下载信息")
|
||||
'测试链接:https://auth.mc-user.com:233/00000000000000000000000000000000/
|
||||
DownloadInfo = GetJson(NetGetCodeByDownload({
|
||||
"https://auth.mc-user.com:233/" & Setup.Get("VersionServerNide", Version:=Version)}, IsJson:=True))
|
||||
Catch ex As Exception
|
||||
Log(ex, "获取统一通行证下载信息失败")
|
||||
End Try
|
||||
'校验文件
|
||||
If DownloadInfo IsNot Nothing Then
|
||||
Dim Checker As New FileChecker(Hash:=DownloadInfo("jarHash").ToString)
|
||||
If (IsSetupSkip AndAlso File.Exists(TargetFile)) OrElse Checker.Check(TargetFile) IsNot Nothing Then
|
||||
'开始下载
|
||||
Log("[Minecraft] 统一通行证需要更新:Hash - " & Checker.Hash, LogLevel.Developer)
|
||||
Result.Add(New NetFile({"https://login.mc-user.com:233/index/jar"}, TargetFile, Checker))
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Log(ex, "获取统一通行证下载信息失败")
|
||||
End Try
|
||||
'校验文件
|
||||
If DownloadInfo IsNot Nothing Then
|
||||
Dim Checker As New FileChecker(Hash:=DownloadInfo("jarHash").ToString)
|
||||
If Checker.Check(TargetFile) IsNot Nothing Then
|
||||
'开始下载
|
||||
Log("[Minecraft] 统一通行证需要更新:Hash - " & Checker.Hash, LogLevel.Developer)
|
||||
Result.Add(New NetFile({"https://login.mc-user.com:233/index/jar"}, TargetFile, Checker))
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
|
||||
'Authlib-Injector 文件
|
||||
If Setup.Get("VersionServerLogin", Version:=Version) = 4 OrElse
|
||||
(PageLinkHiper.HiperState = LoadState.Finished AndAlso Setup.Get("LoginType") = McLoginType.Legacy) Then 'HiPer 登录转接
|
||||
Dim TargetFile = PathAppdata & "authlib-injector.jar"
|
||||
If Not (IsSetupSkip AndAlso File.Exists(TargetFile)) Then
|
||||
Dim DownloadInfo As JObject = Nothing
|
||||
'获取下载信息
|
||||
Try
|
||||
Log("[Minecraft] 开始获取 Authlib-Injector 下载信息")
|
||||
DownloadInfo = GetJson(NetGetCodeByDownload({"https://bmclapi2.bangbang93.com/mirrors/authlib-injector/artifact/latest.json"}, IsJson:=True))
|
||||
Catch ex As Exception
|
||||
Log(ex, "获取 Authlib-Injector 下载信息失败")
|
||||
End Try
|
||||
'校验文件
|
||||
If DownloadInfo IsNot Nothing Then
|
||||
Dim Checker As New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString)
|
||||
If (IsSetupSkip AndAlso File.Exists(TargetFile)) OrElse Checker.Check(TargetFile) IsNot Nothing Then
|
||||
'开始下载
|
||||
Dim DownloadAddress As String = DownloadInfo("download_url")
|
||||
Log("[Minecraft] Authlib-Injector 需要更新:" & DownloadAddress, LogLevel.Developer)
|
||||
Result.Add(New NetFile({DownloadAddress}, TargetFile, New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString)))
|
||||
End If
|
||||
If Setup.Get("VersionServerLogin", Version:=Version) = 4 Then
|
||||
Dim TargetFile = PathPure & "\authlib-injector.jar"
|
||||
Dim DownloadInfo As JObject = Nothing
|
||||
'获取下载信息
|
||||
Try
|
||||
Log("[Minecraft] 开始获取 Authlib-Injector 下载信息")
|
||||
DownloadInfo = GetJson(NetGetCodeByDownload({
|
||||
"https://authlib-injector.yushi.moe/artifact/latest.json",
|
||||
"https://bmclapi2.bangbang93.com/mirrors/authlib-injector/artifact/latest.json"
|
||||
}, IsJson:=True))
|
||||
Catch ex As Exception
|
||||
Log(ex, "获取 Authlib-Injector 下载信息失败")
|
||||
End Try
|
||||
'校验文件
|
||||
If DownloadInfo IsNot Nothing Then
|
||||
Dim Checker As New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString)
|
||||
If Checker.Check(TargetFile) IsNot Nothing Then
|
||||
'开始下载
|
||||
Dim DownloadAddress As String = DownloadInfo("download_url").ToString.
|
||||
Replace("bmclapi2.bangbang93.com/mirrors/authlib-injector", "authlib-injector.yushi.moe")
|
||||
Log("[Minecraft] Authlib-Injector 需要更新:" & DownloadAddress, LogLevel.Developer)
|
||||
Result.Add(New NetFile({
|
||||
DownloadAddress,
|
||||
DownloadAddress.Replace("authlib-injector.yushi.moe", "bmclapi2.bangbang93.com/mirrors/authlib-injector")
|
||||
}, TargetFile, New FileChecker(Hash:=DownloadInfo("checksums")("sha256").ToString)))
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
|
||||
'跳过校验
|
||||
If ShouldIgnoreFileCheck(Version) Then
|
||||
Log("[Minecraft] 用户要求尽量忽略文件检查,这可能会保留有误的文件")
|
||||
Result = Result.Where(
|
||||
Function(f)
|
||||
If File.Exists(f.LocalPath) Then
|
||||
Log("[Minecraft] 跳过下载的支持库文件:" & f.LocalPath, LogLevel.Debug)
|
||||
Return False
|
||||
Else
|
||||
Return True
|
||||
End If
|
||||
End Function).ToList
|
||||
End If
|
||||
|
||||
Return Result
|
||||
End Function
|
||||
''' <summary>
|
||||
''' 将 McLibToken 列表转换为 NetFile。无需下载的文件会被自动过滤。
|
||||
''' </summary>
|
||||
Public Function McLibFixFromLibToken(Libs As List(Of McLibToken), Optional CustomMcFolder As String = Nothing, Optional JumpLoaderFolder As String = Nothing, Optional AllowUnsameFile As Boolean = False) As List(Of NetFile)
|
||||
Public Function McLibFixFromLibToken(Libs As List(Of McLibToken), Optional CustomMcFolder As String = Nothing, Optional JumpLoaderFolder As String = Nothing) As List(Of NetFile)
|
||||
CustomMcFolder = If(CustomMcFolder, PathMcFolder)
|
||||
Dim Result As New List(Of NetFile)
|
||||
'获取
|
||||
For Each Token As McLibToken In Libs
|
||||
'检查文件
|
||||
Dim Checker As FileChecker
|
||||
If AllowUnsameFile Then '只要文件存在则通过检查,用于放宽完整性校验的情况
|
||||
Checker = New FileChecker(MinSize:=1)
|
||||
Else
|
||||
Checker = New FileChecker(ActualSize:=If(Token.Size = 0, -1, Token.Size), Hash:=Token.SHA1)
|
||||
End If
|
||||
Dim Checker As New FileChecker(ActualSize:=If(Token.Size = 0, -1, Token.Size), Hash:=Token.SHA1)
|
||||
If Checker.Check(Token.LocalPath) Is Nothing Then Continue For
|
||||
'文件不符合,添加下载
|
||||
Dim Urls As New List(Of String)
|
||||
If Token.Url Is Nothing AndAlso Token.Name = "net.minecraftforge:forge:universal" Then
|
||||
'特判修复 Forge 部分 universal 文件缺失 URL(#5455)
|
||||
Token.Url = "https://maven.minecraftforge.net" & Token.LocalPath.Replace(If(Token.IsJumpLoader, JumpLoaderFolder, CustomMcFolder) & "libraries", "").Replace("\", "/")
|
||||
End If
|
||||
If Token.Url IsNot Nothing Then
|
||||
'获取 Url 的真实地址
|
||||
'获取 URL 的真实地址
|
||||
Urls.Add(Token.Url)
|
||||
If Token.Url.Contains("launcher.mojang.com/v1/objects") Then
|
||||
Urls = DlSourceLauncherOrMetaGet(Token.Url).ToList() 'Mappings
|
||||
If Token.Url.Contains("launcher.mojang.com/v1/objects") OrElse Token.Url.Contains("client.txt") OrElse
|
||||
Token.Url.Contains(".tsrg") Then
|
||||
Urls.AddRange(DlSourceLauncherOrMetaGet(Token.Url).ToList()) 'Mappings(#4425)
|
||||
End If
|
||||
If Token.Url.Contains("maven") Then
|
||||
Urls.Insert(0, Token.Url.Replace(Mid(Token.Url, 1, Token.Url.IndexOfF("maven")), "https://bmclapi2.bangbang93.com/").
|
||||
@@ -2049,7 +2068,7 @@ OnLoaded:
|
||||
'普通文件
|
||||
Urls.AddRange(DlSourceLibraryGet("https://libraries.minecraft.net" & Token.LocalPath.Replace(If(Token.IsJumpLoader, JumpLoaderFolder, CustomMcFolder) & "libraries", "").Replace("\", "/")))
|
||||
End If
|
||||
Result.Add(New NetFile(Urls.Distinct.ToArray, Token.LocalPath, Checker))
|
||||
Result.Add(New NetFile(Urls.Distinct, Token.LocalPath, Checker))
|
||||
Next
|
||||
'去重并返回
|
||||
Return Result.Distinct(Function(a, b) a.LocalPath = b.LocalPath)
|
||||
@@ -2065,10 +2084,14 @@ OnLoaded:
|
||||
McLibGet = If(WithHead, CustomMcFolder & "libraries\", "") &
|
||||
Splited(0).Replace(".", "\") & "\" & Splited(1) & "\" & Splited(2) & "\" & Splited(1) & "-" & Splited(2) & ".jar"
|
||||
'判断 OptiFine 是否应该使用 installer
|
||||
If McLibGet.Contains("optifine\OptiFine\1.12") AndAlso '仅在 1.12 OptiFine 可重现
|
||||
File.Exists(CustomMcFolder & "libraries\" & Splited(0).Replace(".", "\") & "\" & Splited(1) & "\" & Splited(2) & "\" & Splited(1) & "-" & Splited(2) & "-installer.jar") Then
|
||||
Log("[Launch] 已将 " & Original & " 特判替换为对应的 Installer 文件", LogLevel.Debug)
|
||||
McLibGet = McLibGet.Replace(".jar", "-installer.jar")
|
||||
If McLibGet.Contains("optifine\OptiFine\1.") AndAlso Splited(2).Split(".").Count > 1 Then
|
||||
Dim MajorVersion As Integer = Val(Splited(2).Split(".")(1))
|
||||
Dim MinorVersion As Integer = If(Splited(2).Split(".").Count > 1, Val(Splited(2).Split(".")(2).BeforeFirst("_")), 0)
|
||||
If (MajorVersion = 12 OrElse (MajorVersion = 20 AndAlso MinorVersion >= 4) OrElse MajorVersion >= 21) AndAlso '仅在 1.12 (无法追溯) 和 1.20.4+ (#5376) 遇到此问题
|
||||
File.Exists($"{CustomMcFolder}libraries\{Splited(0).Replace(".", "\")}\{Splited(1)}\{Splited(2)}\{Splited(1)}-{Splited(2)}-installer.jar") Then
|
||||
McLaunchLog("已将 " & Original & " 替换为对应的 Installer 文件")
|
||||
McLibGet = McLibGet.Replace(".jar", "-installer.jar")
|
||||
End If
|
||||
End If
|
||||
End Function
|
||||
|
||||
@@ -2157,77 +2180,50 @@ OnLoaded:
|
||||
''' </summary>
|
||||
Public Size As Long
|
||||
''' <summary>
|
||||
''' 是否为 Virtual 资源文件。
|
||||
''' </summary>
|
||||
Public IsVirtual As Boolean
|
||||
''' <summary>
|
||||
''' 文件的 Hash 校验码。
|
||||
''' </summary>
|
||||
Public Hash As String
|
||||
|
||||
Public Overrides Function ToString() As String
|
||||
Return If(IsVirtual, "[Virtual] ", "") & GetString(Size) & " | " & LocalPath
|
||||
Return GetString(Size) & " | " & LocalPath
|
||||
End Function
|
||||
End Structure
|
||||
''' <summary>
|
||||
''' 获取 Minecraft 的资源文件列表。失败会抛出异常。
|
||||
''' </summary>
|
||||
''' <param name="Name">版本的资源名称,如“1.13.1”。</param>
|
||||
Private Function McAssetsListGet(Name As String) As List(Of McAssetsToken)
|
||||
Private Function McAssetsListGet(Version As McVersion) As List(Of McAssetsToken)
|
||||
Dim IndexName = McAssetsGetIndexName(Version)
|
||||
Try
|
||||
|
||||
'初始化
|
||||
If Not File.Exists(PathMcFolder & "assets\indexes\" & Name & ".json") Then Throw New FileNotFoundException("Assets 索引文件未找到", PathMcFolder & "assets\indexes\" & Name & ".json")
|
||||
McAssetsListGet = New List(Of McAssetsToken)
|
||||
Dim Json = GetJson(ReadFile(PathMcFolder & "assets\indexes\" & Name & ".json"))
|
||||
If Not File.Exists($"{PathMcFolder}assets\indexes\{IndexName}.json") Then Throw New FileNotFoundException("未找到 Asset Index", PathMcFolder & "assets\indexes\" & IndexName & ".json")
|
||||
Dim Result As New List(Of McAssetsToken)
|
||||
Dim Json As JObject = GetJson(ReadFile($"{PathMcFolder}assets\indexes\{IndexName}.json"))
|
||||
|
||||
'确认 Virtual 与 Map 状态
|
||||
Dim IsVirtual As Boolean = False
|
||||
If Json("virtual") IsNot Nothing AndAlso Json("virtual").ToString Then IsVirtual = True
|
||||
If Json("map_to_resources") IsNot Nothing AndAlso Json("map_to_resources").ToString Then
|
||||
IsVirtual = True
|
||||
'刷新 resources 文件夹符号链接(#2182)
|
||||
'Dim Info As FileSystemInfo = New FileInfo(PathMcFolder & "resources\pack.mcmeta")
|
||||
'If Info.Attributes.HasFlag(FileAttributes.ReparsePoint) Then
|
||||
If Not File.Exists(PathMcFolder & "resources\pack.mcmeta") Then
|
||||
Log("[Minecraft] 尝试刷新 resources 文件夹符号链接", LogLevel.Debug)
|
||||
Try
|
||||
DeleteDirectory(PathMcFolder & "resources\", True)
|
||||
Directory.CreateDirectory(PathMcFolder & "assets\virtual\legacy\")
|
||||
Dim Result = ShellAndGetOutput("cmd", $"/C mklink /D /J ""{PathMcFolder}resources"" ""{PathMcFolder}assets\virtual\legacy""")
|
||||
Log($"[Minecraft] 符号链接创建结果:{Result}")
|
||||
If Not Result.Contains("<<===>>") Then Throw New Exception($"非预期的结果({Result})")
|
||||
Catch ex As Exception
|
||||
Log(ex, "创建资源文件夹链接失败,游戏可能会没有声音", LogLevel.Msgbox)
|
||||
End Try
|
||||
'读取列表
|
||||
For Each File As JProperty In Json("objects").Children
|
||||
Dim LocalPath As String
|
||||
If Json("map_to_resources") IsNot Nothing AndAlso Json("map_to_resources").ToObject(Of Boolean) Then
|
||||
'Remap
|
||||
LocalPath = Version.PathIndie & "resources\" & File.Name.Replace("/", "\")
|
||||
ElseIf Json("virtual") IsNot Nothing AndAlso Json("virtual").ToObject(Of Boolean) Then
|
||||
'Virtual
|
||||
LocalPath = PathMcFolder & "assets\virtual\legacy\" & File.Name.Replace("/", "\")
|
||||
Else
|
||||
'正常
|
||||
LocalPath = PathMcFolder & "assets\objects\" & Left(File.Value("hash").ToString, 2) & "\" & File.Value("hash").ToString
|
||||
End If
|
||||
End If
|
||||
|
||||
'加载列表
|
||||
If IsVirtual Then
|
||||
For Each File As JProperty In Json("objects").Children
|
||||
McAssetsListGet.Add(New McAssetsToken With {
|
||||
.IsVirtual = True,
|
||||
.LocalPath = PathMcFolder & "assets\virtual\legacy\" & File.Name.Replace("/", "\"),
|
||||
.SourcePath = File.Name,
|
||||
.Hash = File.Value("hash").ToString,
|
||||
.Size = File.Value("size").ToString
|
||||
})
|
||||
Next
|
||||
Else
|
||||
For Each File As JProperty In Json("objects").Children
|
||||
McAssetsListGet.Add(New McAssetsToken With {
|
||||
.IsVirtual = False,
|
||||
.LocalPath = PathMcFolder & "assets\objects\" & Left(File.Value("hash").ToString, 2) & "\" & File.Value("hash").ToString,
|
||||
.SourcePath = File.Name,
|
||||
.Hash = File.Value("hash").ToString,
|
||||
.Size = File.Value("size").ToString
|
||||
})
|
||||
Next
|
||||
End If
|
||||
Result.Add(New McAssetsToken With {
|
||||
.LocalPath = LocalPath,
|
||||
.SourcePath = File.Name,
|
||||
.Hash = File.Value("hash").ToString,
|
||||
.Size = File.Value("size").ToString
|
||||
})
|
||||
Next
|
||||
Return Result
|
||||
|
||||
Catch ex As Exception
|
||||
Log(ex, "获取资源文件列表失败:" & Name)
|
||||
Log(ex, "获取资源文件列表失败:" & IndexName)
|
||||
Throw
|
||||
End Try
|
||||
End Function
|
||||
@@ -2236,12 +2232,12 @@ OnLoaded:
|
||||
''' <summary>
|
||||
''' 获取版本缺失的资源文件所对应的 NetTaskFile。
|
||||
''' </summary>
|
||||
Public Function McAssetsFixList(IndexAddress As String, CheckHash As Boolean, Optional ByRef ProgressFeed As LoaderBase = Nothing) As List(Of NetFile)
|
||||
Public Function McAssetsFixList(Version As McVersion, CheckHash As Boolean, Optional ByRef ProgressFeed As LoaderBase = Nothing) As List(Of NetFile)
|
||||
Dim Result As New List(Of NetFile)
|
||||
|
||||
Dim AssetsList As List(Of McAssetsToken)
|
||||
Try
|
||||
AssetsList = McAssetsListGet(IndexAddress)
|
||||
AssetsList = McAssetsListGet(Version)
|
||||
Dim Token As McAssetsToken
|
||||
If ProgressFeed IsNot Nothing Then ProgressFeed.Progress = 0.04
|
||||
For i = 0 To AssetsList.Count - 1
|
||||
@@ -2320,8 +2316,8 @@ OnLoaded:
|
||||
End If
|
||||
Left = Left.ToLowerInvariant
|
||||
Right = Right.ToLowerInvariant
|
||||
Dim Lefts = RegexSearch(Left.Replace("快照", "snapshot"), "[a-z]+|[0-9]+")
|
||||
Dim Rights = RegexSearch(Right.Replace("快照", "snapshot"), "[a-z]+|[0-9]+")
|
||||
Dim Lefts = RegexSearch(Left.Replace("快照", "snapshot").Replace("预览版", "pre"), "[a-z]+|[0-9]+")
|
||||
Dim Rights = RegexSearch(Right.Replace("快照", "snapshot").Replace("预览版", "pre"), "[a-z]+|[0-9]+")
|
||||
Dim i As Integer = 0
|
||||
While True
|
||||
'两边均缺失,感觉是一个东西
|
||||
@@ -2370,15 +2366,11 @@ NextEntry:
|
||||
''' <summary>
|
||||
''' 比较两个版本名的排序器。
|
||||
''' </summary>
|
||||
Public Class VersionSorter
|
||||
Public Class VersionComparer
|
||||
Implements IComparer(Of String)
|
||||
Public IsDecreased As Boolean = True
|
||||
Public Function Compare(x As String, y As String) As Integer Implements IComparer(Of String).Compare
|
||||
Return VersionSortInteger(x, y) * If(IsDecreased, -1, 1)
|
||||
Return VersionSortInteger(x, y)
|
||||
End Function
|
||||
Public Sub New(Optional IsDecreased As Boolean = True)
|
||||
Me.IsDecreased = IsDecreased
|
||||
End Sub
|
||||
End Class
|
||||
|
||||
''' <summary>
|
||||
|
||||
@@ -1,6 +1,7 @@
|
||||
Imports System.IO.Compression
|
||||
|
||||
Public Module ModMod
|
||||
Private Const LocalModCacheVersion As Integer = 7
|
||||
|
||||
Public Class McMod
|
||||
|
||||
@@ -47,7 +48,7 @@ Public Module ModMod
|
||||
Get
|
||||
Load()
|
||||
If Not IsFileAvailable Then
|
||||
Return McModState.Unavaliable
|
||||
Return McModState.Unavailable
|
||||
ElseIf Path.EndsWithF(".disabled", True) OrElse Path.EndsWithF(".old", True) Then
|
||||
Return McModState.Disabled
|
||||
Else
|
||||
@@ -58,7 +59,7 @@ Public Module ModMod
|
||||
Public Enum McModState As Integer
|
||||
Fine = 0
|
||||
Disabled = 1
|
||||
Unavaliable = 2
|
||||
Unavailable = 2
|
||||
End Enum
|
||||
|
||||
#End Region
|
||||
@@ -687,7 +688,7 @@ Finished:
|
||||
''' </summary>
|
||||
Public ReadOnly Property CanUpdate As Boolean
|
||||
Get
|
||||
Return ChangelogUrls.Any()
|
||||
Return Not Setup.Get("UiHiddenFunctionModUpdate") AndAlso ChangelogUrls.Any()
|
||||
End Get
|
||||
End Property
|
||||
|
||||
@@ -701,13 +702,13 @@ Finished:
|
||||
Dim Info As New FileInfo(Path)
|
||||
Dim CacheKey As String = GetHash($"{RawPath}-{Info.LastWriteTime.ToLongTimeString}-{Info.Length}-C")
|
||||
Dim Cached As String = ReadIni(PathTemp & "Cache\ModHash.ini", CacheKey)
|
||||
If Cached <> "" Then
|
||||
If Cached <> "" AndAlso RegexCheck(Cached, "^\d+$") Then '#5062
|
||||
_CurseForgeHash = Cached
|
||||
Return _CurseForgeHash
|
||||
End If
|
||||
'读取文件
|
||||
Dim data As New List(Of Byte)
|
||||
For Each b As Byte In File.ReadAllBytes(Path)
|
||||
For Each b As Byte In ReadFileBytes(Path)
|
||||
If b = 9 OrElse b = 10 OrElse b = 13 OrElse b = 32 Then Continue For
|
||||
data.Add(b)
|
||||
Next
|
||||
@@ -814,7 +815,7 @@ Finished:
|
||||
|
||||
'等待 Mod 更新完成
|
||||
If PageVersionMod.UpdatingVersions.Contains(Loader.Input) Then
|
||||
Log($"[Mod] 等待 Mod 更新完成后才能继续加载 Mod 列表")
|
||||
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)
|
||||
@@ -824,6 +825,7 @@ Finished:
|
||||
Finally
|
||||
RunInUiWait(Sub() If FrmVersionMod IsNot Nothing Then FrmVersionMod.Load.Text = "正在加载 Mod 列表")
|
||||
End Try
|
||||
FrmVersionMod.LoaderRun(LoaderFolderRunType.UpdateOnly)
|
||||
End If
|
||||
|
||||
'获取 Mod 文件夹下的可用文件列表
|
||||
@@ -852,7 +854,7 @@ Finished:
|
||||
Dim Cache As New JObject
|
||||
Try
|
||||
Dim CacheContent As String = ReadFile(CachePath)
|
||||
If CacheContent <> "" Then
|
||||
If Not String.IsNullOrWhiteSpace(CacheContent) Then
|
||||
Cache = GetJson(CacheContent)
|
||||
If Not Cache.ContainsKey("version") OrElse Cache("version").ToObject(Of Integer) <> LocalModCacheVersion Then
|
||||
Log($"[Mod] 本地 Mod 信息缓存版本已过期,将弃用这些缓存信息", LogLevel.Debug)
|
||||
@@ -861,6 +863,7 @@ Finished:
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Log(ex, "读取本地 Mod 信息缓存失败,已重置")
|
||||
Cache = New JObject
|
||||
End Try
|
||||
Cache("version") = LocalModCacheVersion
|
||||
|
||||
@@ -886,7 +889,7 @@ Finished:
|
||||
End If
|
||||
ModList.Add(ModEntry)
|
||||
'读取 Comp 缓存
|
||||
If ModEntry.State = McMod.McModState.Unavaliable Then Continue For
|
||||
If ModEntry.State = McMod.McModState.Unavailable Then Continue For
|
||||
Dim CacheKey = ModEntry.ModrinthHash & PageVersionLeft.Version.Version.McName & GetTargetModLoaders().Join("")
|
||||
If Cache.ContainsKey(CacheKey) Then
|
||||
ModEntry.FromJson(Cache(CacheKey))
|
||||
@@ -901,8 +904,8 @@ Finished:
|
||||
'排序
|
||||
ModList = Sort(ModList,
|
||||
Function(Left As McMod, Right As McMod) As Boolean
|
||||
If (Left.State = McMod.McModState.Unavaliable) <> (Right.State = McMod.McModState.Unavaliable) Then
|
||||
Return Left.State = McMod.McModState.Unavaliable
|
||||
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
|
||||
@@ -924,7 +927,6 @@ Finished:
|
||||
End Try
|
||||
End Sub
|
||||
'联网加载 Mod 详情
|
||||
Private Const LocalModCacheVersion As Integer = 5
|
||||
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
|
||||
@@ -944,7 +946,7 @@ Finished:
|
||||
'McVersions = McVersions.Distinct().ToList()
|
||||
'开始网络获取
|
||||
Log($"[Mod] 目标加载器:{ModLoaders.Join("/")},版本:{McVersion}")
|
||||
Dim EndedThreadCount As Integer = 0, SucceedThreadCount As Integer = 0
|
||||
Dim EndedThreadCount As Integer = 0, IsFailed As Boolean = False
|
||||
Dim MainThread As Thread = Thread.CurrentThread
|
||||
'从 Modrinth 获取信息
|
||||
RunInNewThread(
|
||||
@@ -952,7 +954,7 @@ Finished:
|
||||
Try
|
||||
'步骤 1:获取 Hash 与对应的工程 ID
|
||||
Dim ModrinthHashes = Mods.Select(Function(m) m.ModrinthHash).ToList()
|
||||
Dim ModrinthVersion = CType(GetJson(NetRequestRetry("https://api.modrinth.com/v2/version_files", "POST",
|
||||
Dim ModrinthVersion = CType(GetJson(DlModRequest("https://api.modrinth.com/v2/version_files", "POST",
|
||||
$"{{""hashes"": [""{ModrinthHashes.Join(""",""")}""], ""algorithm"": ""sha1""}}", "application/json")), JObject)
|
||||
Log($"[Mod] 从 Modrinth 获取到 {ModrinthVersion.Count} 个本地 Mod 的对应信息")
|
||||
'步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
|
||||
@@ -973,19 +975,18 @@ Finished:
|
||||
Log($"[Mod] 需要从 Modrinth 获取 {ModrinthMapping.Count} 个本地 Mod 的工程信息")
|
||||
'步骤 3:获取工程信息
|
||||
If Not ModrinthMapping.Any() Then Exit Sub
|
||||
Dim ModrinthProject = CType(GetJson(NetRequestRetry(
|
||||
Dim ModrinthProject = CType(GetJson(DlModRequest(
|
||||
$"https://api.modrinth.com/v2/projects?ids=[""{ModrinthMapping.Keys.Join(""",""")}""]",
|
||||
"GET", "", "application/json")), JArray)
|
||||
For Each ProjectJson In ModrinthProject
|
||||
Dim Project As New CompProject(ProjectJson)
|
||||
For Each Entry In ModrinthMapping(Project.Id)
|
||||
If Entry.Comp IsNot Nothing AndAlso Entry.Comp.FromCurseForge Then Project.LogoUrl = Entry.Comp.LogoUrl 'Modrinth 的部分 Logo 不是图片,如果可能,使用 CurseForge 的 Logo
|
||||
Entry.Comp = Project
|
||||
Next
|
||||
Next
|
||||
Log($"[Mod] 已从 Modrinth 获取本地 Mod 信息,继续获取更新信息")
|
||||
'步骤 4:获取更新信息
|
||||
Dim ModrinthUpdate = CType(GetJson(NetRequestRetry("https://api.modrinth.com/v2/version_files/update", "POST",
|
||||
Dim ModrinthUpdate = CType(GetJson(DlModRequest("https://api.modrinth.com/v2/version_files/update", "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")), JObject)
|
||||
For Each Entry In Mods
|
||||
@@ -1005,9 +1006,9 @@ Finished:
|
||||
End If
|
||||
Next
|
||||
Log($"[Mod] 从 Modrinth 获取本地 Mod 信息结束")
|
||||
SucceedThreadCount += 1
|
||||
Catch ex As Exception
|
||||
Log(ex, "从 Modrinth 获取本地 Mod 信息失败")
|
||||
IsFailed = True
|
||||
Finally
|
||||
EndedThreadCount += 1
|
||||
End Try
|
||||
@@ -1022,8 +1023,8 @@ Finished:
|
||||
CurseForgeHashes.Add(Entry.CurseForgeHash)
|
||||
If Loader.IsAbortedWithThread(MainThread) Then Exit Sub
|
||||
Next
|
||||
Dim CurseForgeRaw = CType(CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/fingerprints/432/", "POST",
|
||||
$"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer)
|
||||
Dim CurseForgeRaw = CType(CType(GetJson(DlModRequest("https://api.curseforge.com/v1/fingerprints/432", "POST",
|
||||
$"{{""fingerprints"": [{CurseForgeHashes.Join(",")}]}}", "application/json")), JObject)("data")("exactMatches"), JContainer)
|
||||
Log($"[Mod] 从 CurseForge 获取到 {CurseForgeRaw.Count} 个本地 Mod 的对应信息")
|
||||
'步骤 2:尝试读取工程信息缓存,构建其他 Mod 的对应关系
|
||||
If Not CurseForgeRaw.Any() Then Exit Sub
|
||||
@@ -1045,17 +1046,16 @@ Finished:
|
||||
Log($"[Mod] 需要从 CurseForge 获取 {CurseForgeMapping.Count} 个本地 Mod 的工程信息")
|
||||
'步骤 3:获取工程信息
|
||||
If Not CurseForgeMapping.Any() Then Exit Sub
|
||||
Dim CurseForgeProject = CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods", "POST",
|
||||
$"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")), JObject)("data")
|
||||
Dim CurseForgeProject = CType(GetJson(DlModRequest("https://api.curseforge.com/v1/mods", "POST",
|
||||
$"{{""modIds"": [{CurseForgeMapping.Keys.Join(",")}]}}", "application/json")), JObject)("data")
|
||||
Dim UpdateFileIds As New Dictionary(Of Integer, List(Of McMod)) 'FileId -> 本地 Mod 文件列表
|
||||
Dim FileIdToProjectSlug As New Dictionary(Of Integer, String)
|
||||
For Each ProjectJson In CurseForgeProject
|
||||
If Not ProjectJson("isAvailable").ToObject(Of Boolean) Then Continue For
|
||||
If ProjectJson("isAvailable") IsNot Nothing AndAlso Not ProjectJson("isAvailable").ToObject(Of Boolean) Then Continue For
|
||||
'设置 Entry 中的工程信息
|
||||
Dim Project As New CompProject(ProjectJson)
|
||||
For Each Entry In CurseForgeMapping(Project.Id) '倒查防止 CurseForge 返回的内容有漏
|
||||
If Entry.Comp IsNot Nothing AndAlso Not Entry.Comp.FromCurseForge Then
|
||||
Entry.Comp.LogoUrl = Project.LogoUrl 'Modrinth 部分 Logo 加载不出来
|
||||
Entry.Comp = Entry.Comp '再次触发修改事件
|
||||
Continue For
|
||||
End If
|
||||
@@ -1066,9 +1066,9 @@ Finished:
|
||||
Dim NewestVersion As String = Nothing
|
||||
Dim NewestFileIds As New List(Of Integer)
|
||||
For Each IndexEntry In ProjectJson("latestFilesIndexes")
|
||||
If ModLoaders.Single <> IndexEntry("modLoader")?.ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配
|
||||
If IndexEntry("modLoader") Is Nothing OrElse ModLoaders.Single <> IndexEntry("modLoader").ToObject(Of Integer) Then Continue For 'ModLoader 唯一且匹配
|
||||
Dim IndexVersion As String = IndexEntry("gameVersion")
|
||||
If McVersion <> IndexVersion Then Continue For 'MC 版本匹配
|
||||
If IndexVersion <> McVersion Then Continue For 'MC 版本匹配
|
||||
'由于 latestFilesIndexes 是按时间从新到老排序的,所以只需取第一个;如果需要检查多个 releaseType 下的文件,将 > -1 改为 = 1,但这应当并不会获取到更新的文件
|
||||
If NewestVersion IsNot Nothing AndAlso VersionSortInteger(NewestVersion, IndexVersion) > -1 Then Continue For '只保留最新 MC 版本
|
||||
If NewestVersion <> IndexVersion Then
|
||||
@@ -1087,7 +1087,7 @@ Finished:
|
||||
Log($"[Mod] 已从 CurseForge 获取本地 Mod 信息,需要获取 {UpdateFileIds.Count} 个用于检查更新的文件信息")
|
||||
'步骤 4:获取更新文件信息
|
||||
If Not UpdateFileIds.Any() Then Exit Sub
|
||||
Dim CurseForgeFiles = CType(GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST",
|
||||
Dim CurseForgeFiles = CType(GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST",
|
||||
$"{{""fileIds"": [{UpdateFileIds.Keys.Join(",")}]}}", "application/json")), JObject)("data")
|
||||
Dim UpdateFiles As New Dictionary(Of McMod, CompFile)
|
||||
For Each FileJson In CurseForgeFiles
|
||||
@@ -1113,9 +1113,9 @@ Finished:
|
||||
End If
|
||||
Next
|
||||
Log($"[Mod] 从 CurseForge 获取 Mod 更新信息结束")
|
||||
SucceedThreadCount += 1
|
||||
Catch ex As Exception
|
||||
Log(ex, "从 CurseForge 获取本地 Mod 信息失败")
|
||||
IsFailed = True
|
||||
Finally
|
||||
EndedThreadCount += 1
|
||||
End Try
|
||||
@@ -1129,11 +1129,13 @@ Finished:
|
||||
Mods = Mods.Where(Function(m) m.Comp IsNot Nothing).ToList()
|
||||
Log($"[Mod] 联网获取本地 Mod 信息完成,为 {Mods.Count} 个 Mod 更新缓存")
|
||||
If Not Mods.Any() Then Exit Sub
|
||||
For Each Entry In Mods 'TODO: Bookshelf 的 Logo 会在两个网站间横跳
|
||||
Entry.CompLoaded = SucceedThreadCount = 2
|
||||
For Each Entry In Mods
|
||||
Entry.CompLoaded = Not IsFailed
|
||||
Cache(Entry.ModrinthHash & McVersion & ModLoaders.Join("")) = Entry.ToJson()
|
||||
Next
|
||||
WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
|
||||
'刷新边栏
|
||||
RunInUi(Sub() FrmVersionMod?.RefreshBars())
|
||||
End Sub
|
||||
Private Function GetTargetModLoaders() As List(Of CompModLoaderType)
|
||||
Dim ModLoaders As New List(Of CompModLoaderType)
|
||||
@@ -1275,4 +1277,4 @@ Finished:
|
||||
End Function
|
||||
#End If
|
||||
|
||||
End Module
|
||||
End Module
|
||||
@@ -1,4 +1,5 @@
|
||||
Imports System.IO.Compression
|
||||
Imports System.Linq.Expressions
|
||||
|
||||
Public Module ModModpack
|
||||
|
||||
@@ -9,12 +10,22 @@ Public Module ModModpack
|
||||
Public Sub ModpackInstall()
|
||||
Dim File As String = SelectFile("整合包文件(*.rar;*.zip;*.mrpack)|*.rar;*.zip;*.mrpack", "选择整合包压缩文件") '选择整合包文件
|
||||
If String.IsNullOrEmpty(File) Then Exit Sub
|
||||
RunInThread(Sub() ModpackInstall(File))
|
||||
RunInThread(
|
||||
Sub()
|
||||
Try
|
||||
ModpackInstall(File)
|
||||
Catch ex As CancelledException
|
||||
Catch ex As Exception
|
||||
Log(ex, "手动安装整合包失败", LogLevel.Msgbox)
|
||||
End Try
|
||||
End Sub)
|
||||
End Sub
|
||||
''' <summary>
|
||||
''' 安装一个给定的整合包文件,返回是否安装成功。必须在工作线程执行。
|
||||
''' 构建并启动安装给定的整合包文件的加载器,并返回该加载器。若失败则抛出异常。
|
||||
''' 必须在工作线程执行。
|
||||
''' </summary>
|
||||
Public Function ModpackInstall(File As String, Optional VersionName As String = Nothing, Optional ShowHint As Boolean = True, Optional Logo As String = Nothing) As Boolean
|
||||
''' <exception cref="CancelledException" />
|
||||
Public Function ModpackInstall(File As String, Optional VersionName 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 = ""
|
||||
@@ -22,7 +33,7 @@ Public Module ModModpack
|
||||
'获取整合包种类与关键 Json
|
||||
Dim PackType As Integer = -1
|
||||
Try
|
||||
Archive = New ZipArchive(New FileStream(File, FileMode.Open, FileAccess.Read, FileShare.ReadWrite))
|
||||
Archive = New ZipArchive(New FileStream(File, FileMode.Open, FileAccess.Read, FileShare.Read))
|
||||
'从根目录判断整合包类型
|
||||
If Archive.GetEntry("mcbbs.packmeta") IsNot Nothing Then PackType = 3 : Exit Try 'MCBBS 整合包(优先于 manifest.json 判断)
|
||||
If Archive.GetEntry("mmc-pack.json") IsNot Nothing Then PackType = 2 : Exit Try 'MMC 整合包(优先于 manifest.json 判断,#4194)
|
||||
@@ -36,15 +47,16 @@ Public Module ModModpack
|
||||
End If
|
||||
End If
|
||||
If Archive.GetEntry("modpack.json") IsNot Nothing Then PackType = 1 : Exit Try 'HMCL 整合包
|
||||
If Archive.GetEntry("modpack.zip") IsNot Nothing OrElse Archive.GetEntry("modpack.mrpack") IsNot Nothing Then PackType = 9 : Exit Try '带启动器的压缩包
|
||||
'从一级目录判断整合包类型
|
||||
For Each Entry In Archive.Entries
|
||||
Dim FullNames As String() = Entry.FullName.Split("/")
|
||||
ArchiveBaseFolder = FullNames(0) & "/"
|
||||
If Entry.FullName.EndsWithF("/versions/") AndAlso FullNames.Count = 3 Then PackType = 9 : Exit Try '压缩包
|
||||
'确定为一级目录下
|
||||
If FullNames.Count <> 2 Then Continue For
|
||||
'判断是否为关键文件
|
||||
If FullNames(1) = "mcbbs.packmeta" Then PackType = 3 : Exit Try 'MCBBS 整合包(优先于 manifest.json 判断)
|
||||
If FullNames(1) = "mmc-pack.json" Then PackType = 2 : Exit Try 'MMC 整合包(优先于 manifest.json 判断,#4194)
|
||||
If FullNames(1) = "modrinth.index.json" Then PackType = 4 : Exit Try 'Modrinth 整合包
|
||||
If FullNames(1) = "manifest.json" Then
|
||||
Dim Json As JObject = GetJson(ReadFile(Entry.Open, Encoding.UTF8))
|
||||
@@ -55,54 +67,41 @@ Public Module ModModpack
|
||||
End If
|
||||
End If
|
||||
If FullNames(1) = "modpack.json" Then PackType = 1 : Exit Try 'HMCL 整合包
|
||||
If FullNames(1) = "mmc-pack.json" Then PackType = 2 : Exit Try 'MMC 整合包
|
||||
If FullNames(1) = "modpack.zip" OrElse FullNames(1) = "modpack.mrpack" Then PackType = 9 : Exit Try '带启动器的压缩包
|
||||
Next
|
||||
Catch ex As Exception
|
||||
If GetExceptionDetail(ex, True).Contains("Error.WinIOError") Then
|
||||
Log(ex, "打开整合包文件失败", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
|
||||
Return False
|
||||
Throw New Exception("打开整合包文件失败", ex)
|
||||
ElseIf File.EndsWithF(".rar", True) Then
|
||||
Log(ex, "PCL 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
|
||||
Return False
|
||||
Throw New Exception("PCL 无法处理 rar 格式的压缩包,请在解压后重新压缩为 zip 格式再试", ex)
|
||||
Else
|
||||
Log(ex, "打开整合包文件失败,文件可能损坏或为不支持的压缩包格式", If(ShowHint, LogLevel.Hint, LogLevel.Normal))
|
||||
Return False
|
||||
Throw New Exception("打开整合包文件失败,文件可能损坏或为不支持的压缩包格式", ex)
|
||||
End If
|
||||
End Try
|
||||
'执行对应的安装方法
|
||||
Select Case PackType
|
||||
Case 0
|
||||
Log("[ModPack] 整合包种类:CurseForge")
|
||||
InstallPackCurseForge(File, Archive, ArchiveBaseFolder, VersionName, Logo)
|
||||
Return InstallPackCurseForge(File, Archive, ArchiveBaseFolder, VersionName, Logo)
|
||||
Case 1
|
||||
Log("[ModPack] 整合包种类:HMCL")
|
||||
InstallPackHMCL(File, Archive, ArchiveBaseFolder)
|
||||
Return InstallPackHMCL(File, Archive, ArchiveBaseFolder)
|
||||
Case 2
|
||||
Log("[ModPack] 整合包种类:MMC")
|
||||
InstallPackMMC(File, Archive, ArchiveBaseFolder)
|
||||
Return InstallPackMMC(File, Archive, ArchiveBaseFolder)
|
||||
Case 3
|
||||
Log("[ModPack] 整合包种类:MCBBS")
|
||||
InstallPackMCBBS(File, Archive, ArchiveBaseFolder)
|
||||
Return InstallPackMCBBS(File, Archive, ArchiveBaseFolder, VersionName)
|
||||
Case 4
|
||||
Log("[ModPack] 整合包种类:Modrinth")
|
||||
InstallPackModrinth(File, Archive, ArchiveBaseFolder, VersionName, Logo)
|
||||
Return InstallPackModrinth(File, Archive, ArchiveBaseFolder, VersionName, Logo)
|
||||
Case 9
|
||||
Log("[ModPack] 整合包种类:压缩包")
|
||||
Archive.Dispose()
|
||||
Archive = Nothing
|
||||
InstallPackCompress(File, ArchiveBaseFolder)
|
||||
Log("[ModPack] 整合包种类:带启动器的压缩包")
|
||||
Return InstallPackLauncherPack(File, Archive, ArchiveBaseFolder)
|
||||
Case Else
|
||||
If ShowHint Then
|
||||
Hint("未能识别该整合包的种类,无法安装!", HintType.Critical)
|
||||
Else
|
||||
Log("[ModPack] 未能识别该整合包的种类,无法安装!")
|
||||
End If
|
||||
Return False
|
||||
Log("[ModPack] 整合包种类:未能识别,假定为压缩包")
|
||||
Return InstallPackCompress(File, Archive)
|
||||
End Select
|
||||
Return True
|
||||
Catch ex As Exception
|
||||
Log(ex, "准备安装整合包失败", LogLevel.Feedback)
|
||||
Return False
|
||||
Finally
|
||||
If Archive IsNot Nothing Then Archive.Dispose()
|
||||
End Try
|
||||
@@ -111,7 +110,7 @@ Public Module ModModpack
|
||||
'整合包缓存清理
|
||||
Private IsInstallCacheCleared As Boolean = False
|
||||
Private IsInstallCacheClearing As Boolean = False
|
||||
Private Sub UnpackFiles(InstallTemp As String, FileAddress As String, Loader As LoaderBase)
|
||||
Private Sub ExtractModpackFiles(InstallTemp As String, FileAddress As String, Loader As LoaderBase, LoaderProgressDelta As Double)
|
||||
'清理缓存文件夹
|
||||
If Not IsInstallCacheCleared Then
|
||||
IsInstallCacheCleared = True
|
||||
@@ -138,7 +137,7 @@ Public Module ModModpack
|
||||
Retry:
|
||||
'完全不知道为啥会出现文件正在被另一进程使用的问题,总之多试试
|
||||
DeleteDirectory(InstallTemp)
|
||||
ExtractFile(FileAddress, InstallTemp, Encode)
|
||||
ExtractFile(FileAddress, InstallTemp, Encode, ProgressIncrementHandler:=Sub(Delta) Loader.Progress += Delta * LoaderProgressDelta)
|
||||
Catch ex As Exception
|
||||
Log(ex, "第 " & RetryCount & " 次解压尝试失败")
|
||||
If TypeOf ex Is ArgumentException Then
|
||||
@@ -151,7 +150,7 @@ Retry:
|
||||
RetryCount += 1
|
||||
GoTo Retry
|
||||
Else
|
||||
Throw
|
||||
Throw New Exception("解压整合包文件失败", ex)
|
||||
End If
|
||||
End Try
|
||||
End Sub
|
||||
@@ -159,26 +158,25 @@ Retry:
|
||||
#Region "不同类型整合包的安装方法"
|
||||
|
||||
'CurseForge
|
||||
Private Sub InstallPackCurseForge(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing)
|
||||
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)
|
||||
|
||||
'读取 Json 文件
|
||||
Dim Json As JObject
|
||||
Try
|
||||
Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "manifest.json").Open))
|
||||
If Json("minecraft") Is Nothing OrElse Json("minecraft")("version") Is Nothing Then Throw New Exception("整合包未提供 Minecraft 版本信息")
|
||||
Catch ex As Exception
|
||||
Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
|
||||
Exit Sub
|
||||
Throw New Exception("CurseForge 整合包安装信息存在问题", ex)
|
||||
End Try
|
||||
If Json("minecraft") Is Nothing OrElse Json("minecraft")("version") Is Nothing Then Throw New Exception("CurseForge 整合包未提供 Minecraft 版本信息")
|
||||
|
||||
'获取版本名
|
||||
Dim ShowRibble As Boolean = VersionName Is Nothing
|
||||
If VersionName Is Nothing Then
|
||||
Dim PackName As String = If(Json("name"), "")
|
||||
VersionName = If(Json("name"), "")
|
||||
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
|
||||
If Validate.Validate(PackName) <> "" Then PackName = ""
|
||||
VersionName = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate})
|
||||
If String.IsNullOrEmpty(VersionName) Then Exit Sub
|
||||
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
|
||||
End If
|
||||
|
||||
'获取 Mod API 版本信息
|
||||
@@ -189,35 +187,19 @@ Retry:
|
||||
Dim Id As String = If(Entry("id"), "").ToString.ToLower
|
||||
If Id.StartsWithF("forge-") Then
|
||||
'Forge 指定
|
||||
If Id.Contains("recommended") Then
|
||||
Log("[ModPack] 该整合包版本过老,已不支持进行安装!", LogLevel.Hint)
|
||||
Exit Sub
|
||||
End If
|
||||
Try
|
||||
Log("[ModPack] 整合包 Forge 版本:" & Id)
|
||||
ForgeVersion = Id.Replace("forge-", "")
|
||||
Exit For
|
||||
Catch ex As Exception
|
||||
Log(ex, "读取整合包 Forge 版本失败:" & Id)
|
||||
End Try
|
||||
If Id.Contains("recommended") Then Throw New Exception("该整合包版本过老,已不支持进行安装!")
|
||||
Log("[ModPack] 整合包 Forge 版本:" & Id)
|
||||
ForgeVersion = Id.Replace("forge-", "")
|
||||
ElseIf Id.StartsWithF("neoforge-") Then
|
||||
'NeoForge 指定
|
||||
Try
|
||||
Log("[ModPack] 整合包 NeoForge 版本:" & Id)
|
||||
NeoForgeVersion = Id.Replace("neoforge-", "")
|
||||
Exit For
|
||||
Catch ex As Exception
|
||||
Log(ex, "读取整合包 NeoForge 版本失败:" & Id)
|
||||
End Try
|
||||
Log("[ModPack] 整合包 NeoForge 版本:" & Id)
|
||||
NeoForgeVersion = Id.Replace("neoforge-", "")
|
||||
ElseIf Id.StartsWithF("fabric-") Then
|
||||
'Fabric 指定
|
||||
Try
|
||||
Log("[ModPack] 整合包 Fabric 版本:" & Id)
|
||||
FabricVersion = Id.Replace("fabric-", "")
|
||||
Exit For
|
||||
Catch ex As Exception
|
||||
Log(ex, "读取整合包 Fabric 版本失败:" & Id)
|
||||
End Try
|
||||
Log("[ModPack] 整合包 Fabric 版本:" & Id)
|
||||
FabricVersion = Id.Replace("fabric-", "")
|
||||
Else
|
||||
Log("[ModPack] 未知 Mod 加载器:" & Id)
|
||||
End If
|
||||
Next
|
||||
'解压与配置文件
|
||||
@@ -227,17 +209,17 @@ Retry:
|
||||
If OverrideHome <> "" Then
|
||||
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
|
||||
Sub(Task As LoaderTask(Of String, Integer))
|
||||
UnpackFiles(InstallTemp, FileAddress, Task)
|
||||
Task.Progress = 0.5
|
||||
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
|
||||
Task.Progress = 0.6
|
||||
Dim OverridePath As String = InstallTemp & ArchiveBaseFolder & OverrideHome
|
||||
'复制结果
|
||||
If Directory.Exists(OverridePath) Then
|
||||
CopyDirectory(OverridePath, PathMcFolder & "versions\" & VersionName)
|
||||
CopyDirectory(OverridePath, PathMcFolder & "versions\" & VersionName, Sub(Delta) Task.Progress += Delta * 0.35)
|
||||
Log($"[ModPack] 整合包 override 复制:{OverridePath} -> {PathMcFolder & "versions\" & VersionName}")
|
||||
Else
|
||||
Log($"[ModPack] 整合包中未找到 override 文件夹:{OverridePath}")
|
||||
End If
|
||||
Task.Progress = 0.9
|
||||
Task.Progress = 0.95
|
||||
'开启版本隔离
|
||||
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
|
||||
End Sub) With {
|
||||
@@ -259,9 +241,9 @@ Retry:
|
||||
'获取 Mod 下载信息
|
||||
ModDownloadLoaders.Add(New LoaderTask(Of Integer, JArray)("获取 Mod 下载信息",
|
||||
Sub(Task As LoaderTask(Of Integer, JArray))
|
||||
Task.Output = GetJson(NetRequestRetry("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(ModList, ",") & "]}", "application/json"))("data")
|
||||
Task.Output = GetJson(DlModRequest("https://api.curseforge.com/v1/mods/files", "POST", "{""fileIds"": [" & Join(ModList, ",") & "]}", "application/json"))("data")
|
||||
'如果文件已被删除,则 API 会跳过那一项
|
||||
If ModList.Count > Task.Output.Count Then Throw New Exception("整合包所需要的部分 Mod 版本已被 Mod 作者删除,因此无法完成整合包安装,请联系整合包作者更新整合包中的 Mod 版本")
|
||||
If ModList.Count > Task.Output.Count Then Throw New Exception("整合包中的部分 Mod 版本已被 Mod 作者删除,所以没法继续安装了,请向整合包作者反馈该问题")
|
||||
End Sub) With {.ProgressWeight = ModList.Count / 10}) '每 10 Mod 需要 1s
|
||||
'构造 NetFile
|
||||
ModDownloadLoaders.Add(New LoaderTask(Of JArray, List(Of NetFile))("构造 Mod 下载信息",
|
||||
@@ -319,7 +301,6 @@ Retry:
|
||||
.FabricVersion = FabricVersion
|
||||
}
|
||||
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
|
||||
If MergeLoaders Is Nothing Then Exit Sub
|
||||
'构造 Libraries 加载器
|
||||
Dim LoadersLib As New List(Of LoaderBase)
|
||||
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
|
||||
@@ -341,8 +322,8 @@ Retry:
|
||||
End If
|
||||
'删除原始整合包文件
|
||||
For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
|
||||
If Not Setup.Get("ToolDownloadKeepModpack") AndAlso File.Exists(Target) Then
|
||||
Log("[ModPack] 根据设置要求删除原始整合包文件:" & Target)
|
||||
If File.Exists(Target) Then
|
||||
Log("[ModPack] 删除原始整合包文件:" & Target)
|
||||
File.Delete(Target)
|
||||
End If
|
||||
Next
|
||||
@@ -350,36 +331,31 @@ Retry:
|
||||
|
||||
'重复任务检查
|
||||
Dim LoaderName As String = "CurseForge 整合包安装:" & VersionName & " "
|
||||
SyncLock LoaderTaskbarLock
|
||||
For i = 0 To LoaderTaskbar.Count - 1
|
||||
If LoaderTaskbar(i).Name = LoaderName Then
|
||||
Hint("该整合包正在安装中!", HintType.Critical)
|
||||
Exit Sub
|
||||
End If
|
||||
Next
|
||||
End SyncLock
|
||||
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
|
||||
Hint("该整合包正在安装中!", HintType.Critical)
|
||||
Throw New CancelledException
|
||||
End If
|
||||
|
||||
'启动
|
||||
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
|
||||
Loader.Start(Request.TargetVersionFolder)
|
||||
LoaderTaskbarAdd(Loader)
|
||||
FrmMain.BtnExtraDownload.ShowRefresh()
|
||||
If ShowRibble Then FrmMain.BtnExtraDownload.Ribble()
|
||||
|
||||
End Sub
|
||||
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
|
||||
Return Loader
|
||||
End Function
|
||||
|
||||
'Modrinth
|
||||
Private Sub InstallPackModrinth(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String, Optional VersionName As String = Nothing, Optional Logo As String = Nothing)
|
||||
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)
|
||||
|
||||
'读取 Json 文件
|
||||
Dim Json As JObject
|
||||
Try
|
||||
Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "modrinth.index.json").Open))
|
||||
If Json("dependencies") Is Nothing OrElse Json("dependencies")("minecraft") Is Nothing Then Throw New Exception("整合包未提供 Minecraft 版本信息")
|
||||
Catch ex As Exception
|
||||
Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
|
||||
Exit Sub
|
||||
Throw New Exception("Modrinth 整合包安装信息存在问题", ex)
|
||||
End Try
|
||||
If Json("dependencies") Is Nothing OrElse Json("dependencies")("minecraft") Is Nothing Then Throw New Exception("Modrinth 整合包未提供 Minecraft 版本信息")
|
||||
'获取 Mod API 版本信息
|
||||
Dim MinecraftVersion As String = Nothing
|
||||
Dim ForgeVersion As String = Nothing
|
||||
@@ -400,42 +376,43 @@ Retry:
|
||||
Log("[ModPack] 整合包 Fabric 版本:" & FabricVersion)
|
||||
Case "quilt-loader" 'eg. 1.0.0
|
||||
Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical)
|
||||
Exit Sub
|
||||
Throw New CancelledException
|
||||
Case Else
|
||||
Hint($"无法安装整合包,其中出现了未知的 Mod 加载器 {Entry.Value}!", HintType.Critical)
|
||||
Exit Sub
|
||||
Throw New CancelledException
|
||||
End Select
|
||||
Next
|
||||
'获取版本名
|
||||
Dim ShowRibble As Boolean = VersionName Is Nothing
|
||||
If VersionName Is Nothing Then
|
||||
Dim PackName As String = If(Json("name"), "")
|
||||
VersionName = If(Json("name"), "")
|
||||
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
|
||||
If Validate.Validate(PackName) <> "" Then PackName = ""
|
||||
VersionName = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate})
|
||||
If String.IsNullOrEmpty(VersionName) Then Exit Sub
|
||||
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
|
||||
End If
|
||||
'解压和配置文件
|
||||
Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
|
||||
Dim InstallLoaders As New List(Of LoaderBase)
|
||||
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
|
||||
Sub(Task As LoaderTask(Of String, Integer))
|
||||
UnpackFiles(InstallTemp, FileAddress, Task)
|
||||
Task.Progress = 0.5
|
||||
'复制 overrides 文件夹和 client-overrides 文件夹
|
||||
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then
|
||||
CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName)
|
||||
Else
|
||||
Log("[ModPack] 整合包中未找到 override 目录,已跳过")
|
||||
End If
|
||||
Task.Progress = 0.8
|
||||
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "client-overrides") Then
|
||||
CopyDirectory(InstallTemp & ArchiveBaseFolder & "client-overrides", PathMcFolder & "versions\" & VersionName)
|
||||
End If
|
||||
Task.Progress = 0.9
|
||||
'开启版本隔离
|
||||
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
|
||||
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
|
||||
Sub(Task As LoaderTask(Of String, Integer))
|
||||
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
|
||||
Task.Progress = 0.6
|
||||
'复制 overrides 文件夹和 client-overrides 文件夹
|
||||
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then
|
||||
CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName,
|
||||
Sub(Delta) Task.Progress += Delta * 0.25)
|
||||
Else
|
||||
Log("[ModPack] 整合包中未找到 override 目录,已跳过")
|
||||
End If
|
||||
Task.Progress = 0.85
|
||||
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "client-overrides") Then
|
||||
CopyDirectory(InstallTemp & ArchiveBaseFolder & "client-overrides", PathMcFolder & "versions\" & VersionName,
|
||||
Sub(Delta) Task.Progress += Delta * 0.1)
|
||||
End If
|
||||
Task.Progress = 0.95
|
||||
'开启版本隔离
|
||||
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
|
||||
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
|
||||
'获取下载文件列表
|
||||
Dim FileList As New List(Of NetFile)
|
||||
For Each File In If(Json("files"), {})
|
||||
@@ -452,8 +429,10 @@ Retry:
|
||||
End Select
|
||||
End If
|
||||
'添加下载文件
|
||||
FileList.Add(New NetFile(File("downloads").Select(Function(t) t.ToString.Replace("://edge.forgecdn", "://media.forgecdn")).ToArray, '修复 #2390
|
||||
PathMcFolder & "versions\" & VersionName & "\" & File("path").ToString,
|
||||
Dim Urls = File("downloads").Select(Function(t) t.ToString.Replace("://edge.forgecdn", "://media.forgecdn")).ToList
|
||||
Urls.AddRange(Urls.Select(Function(u) DlSourceModGet(u)).ToList)
|
||||
Urls = Urls.Distinct.ToList()
|
||||
FileList.Add(New NetFile(Urls, PathMcFolder & "versions\" & VersionName & "\" & File("path").ToString,
|
||||
New FileChecker(ActualSize:=File("fileSize").ToObject(Of Long), Hash:=File("hashes")("sha1").ToString), True))
|
||||
Next
|
||||
If FileList.Any Then
|
||||
@@ -470,7 +449,6 @@ Retry:
|
||||
.FabricVersion = FabricVersion
|
||||
}
|
||||
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
|
||||
If MergeLoaders Is Nothing Then Exit Sub
|
||||
'构造 Libraries 加载器
|
||||
Dim LoadersLib As New List(Of LoaderBase)
|
||||
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
|
||||
@@ -492,8 +470,8 @@ Retry:
|
||||
End If
|
||||
'删除原始整合包文件
|
||||
For Each Target As String In {VersionFolder & "原始整合包.zip", VersionFolder & "原始整合包.mrpack"}
|
||||
If Not Setup.Get("ToolDownloadKeepModpack") AndAlso File.Exists(Target) Then
|
||||
Log("[ModPack] 根据设置要求删除原始整合包文件:" & Target)
|
||||
If File.Exists(Target) Then
|
||||
Log("[ModPack] 删除原始整合包文件:" & Target)
|
||||
File.Delete(Target)
|
||||
End If
|
||||
Next
|
||||
@@ -501,69 +479,60 @@ Retry:
|
||||
|
||||
'重复任务检查
|
||||
Dim LoaderName As String = "Modrinth 整合包安装:" & VersionName & " "
|
||||
SyncLock LoaderTaskbarLock
|
||||
For i = 0 To LoaderTaskbar.Count - 1
|
||||
If LoaderTaskbar(i).Name = LoaderName Then
|
||||
Hint("该整合包正在安装中!", HintType.Critical)
|
||||
Exit Sub
|
||||
End If
|
||||
Next
|
||||
End SyncLock
|
||||
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
|
||||
Hint("该整合包正在安装中!", HintType.Critical)
|
||||
Throw New CancelledException
|
||||
End If
|
||||
|
||||
'启动
|
||||
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
|
||||
Loader.Start(Request.TargetVersionFolder)
|
||||
LoaderTaskbarAdd(Loader)
|
||||
FrmMain.BtnExtraDownload.ShowRefresh()
|
||||
If ShowRibble Then FrmMain.BtnExtraDownload.Ribble()
|
||||
|
||||
End Sub
|
||||
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
|
||||
Return Loader
|
||||
End Function
|
||||
|
||||
'HMCL
|
||||
Private Sub InstallPackHMCL(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String)
|
||||
Private Function InstallPackHMCL(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
|
||||
'读取 Json 文件
|
||||
Dim Json As JObject
|
||||
Try
|
||||
Json = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "modpack.json").Open, Encoding.UTF8))
|
||||
Catch ex As Exception
|
||||
Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
|
||||
Exit Sub
|
||||
Throw New Exception("HMCL 整合包安装信息存在问题", ex)
|
||||
End Try
|
||||
'获取版本名
|
||||
Dim PackName As String = If(Json("name"), "")
|
||||
Dim VersionName As String = If(Json("name"), "")
|
||||
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
|
||||
If Validate.Validate(PackName) <> "" Then PackName = ""
|
||||
Dim VersionName As String = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate})
|
||||
If VersionName Is Nothing Then Exit Sub
|
||||
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 InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
|
||||
Dim InstallLoaders As New List(Of LoaderBase)
|
||||
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
|
||||
Sub(Task As LoaderTask(Of String, Integer))
|
||||
UnpackFiles(InstallTemp, FileAddress, Task)
|
||||
Task.Progress = 0.5
|
||||
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
|
||||
Task.Progress = 0.6
|
||||
'复制结果
|
||||
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "minecraft") Then
|
||||
CopyDirectory(InstallTemp & ArchiveBaseFolder & "minecraft", PathMcFolder & "versions\" & VersionName)
|
||||
CopyDirectory(InstallTemp & ArchiveBaseFolder & "minecraft", PathMcFolder & "versions\" & VersionName, Sub(Delta) Task.Progress += Delta * 0.35)
|
||||
Else
|
||||
Log("[ModPack] 整合包中未找到 minecraft override 目录,已跳过")
|
||||
End If
|
||||
Task.Progress = 0.9
|
||||
Task.Progress = 0.95
|
||||
'开启版本隔离
|
||||
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
|
||||
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
|
||||
'构造加载器
|
||||
If Json("gameVersion") Is Nothing Then
|
||||
Hint("该整合包未提供游戏版本信息,无法安装!", HintType.Critical)
|
||||
Exit Sub
|
||||
End If
|
||||
If Json("gameVersion") Is Nothing Then Throw New Exception("该 HMCL 整合包未提供游戏版本信息,无法安装!")
|
||||
Dim Request As New McInstallRequest With {
|
||||
.TargetVersionName = VersionName,
|
||||
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
|
||||
.MinecraftName = Json("gameVersion").ToString
|
||||
}
|
||||
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
|
||||
If MergeLoaders Is Nothing Then Exit Sub
|
||||
'构造 Libraries 加载器(为了使得 Mods 下载结束后再构造,这样才会下载 JumpLoader 文件)
|
||||
Dim LoadersLib As New List(Of LoaderBase)
|
||||
LoadersLib.Add(New LoaderTask(Of String, String)("重命名版本 Json(副加载器)",
|
||||
@@ -591,14 +560,10 @@ Retry:
|
||||
|
||||
'重复任务检查
|
||||
Dim LoaderName As String = "HMCL 整合包安装:" & VersionName & " "
|
||||
SyncLock LoaderTaskbarLock
|
||||
For i = 0 To LoaderTaskbar.Count - 1
|
||||
If LoaderTaskbar(i).Name = LoaderName Then
|
||||
Hint("该整合包正在安装中!", HintType.Critical)
|
||||
Exit Sub
|
||||
End If
|
||||
Next
|
||||
End SyncLock
|
||||
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
|
||||
Hint("该整合包正在安装中!", HintType.Critical)
|
||||
Throw New CancelledException
|
||||
End If
|
||||
|
||||
'启动
|
||||
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
|
||||
@@ -606,41 +571,41 @@ Retry:
|
||||
Loader.Start(Request.TargetVersionFolder)
|
||||
LoaderTaskbarAdd(Loader)
|
||||
FrmMain.BtnExtraDownload.ShowRefresh()
|
||||
FrmMain.BtnExtraDownload.Ribble()
|
||||
End Sub
|
||||
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
|
||||
Return Loader
|
||||
End Function
|
||||
|
||||
'MMC
|
||||
Private Sub InstallPackMMC(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String)
|
||||
Private Function InstallPackMMC(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
|
||||
'读取 Json 文件
|
||||
Dim PackJson As JObject, PackInstance As String
|
||||
Try
|
||||
PackJson = GetJson(ReadFile(Archive.GetEntry(ArchiveBaseFolder & "mmc-pack.json").Open, Encoding.UTF8))
|
||||
PackInstance = ReadFile(Archive.GetEntry(ArchiveBaseFolder & "instance.cfg").Open, Encoding.UTF8)
|
||||
Catch ex As Exception
|
||||
Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
|
||||
Exit Sub
|
||||
Throw New Exception("MMC 整合包安装信息存在问题", ex)
|
||||
End Try
|
||||
'获取版本名
|
||||
Dim PackName As String = If(RegexSeek(PackInstance, "(?<=\nname\=)[^\n]+"), "")
|
||||
Dim VersionName As String = If(RegexSeek(PackInstance, "(?<=\nname\=)[^\n]+"), "")
|
||||
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
|
||||
If Validate.Validate(PackName) <> "" Then PackName = ""
|
||||
Dim VersionName As String = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate})
|
||||
If VersionName Is Nothing Then Exit Sub
|
||||
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 InstallTemp As String = $"{PathTemp}PackInstall\{RandomInteger(0, 100000)}\"
|
||||
Dim SetupFile As String = $"{PathMcFolder}versions\{VersionName}\PCL\Setup.ini"
|
||||
Dim InstallLoaders As New List(Of LoaderBase)
|
||||
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
|
||||
Sub(Task As LoaderTask(Of String, Integer))
|
||||
UnpackFiles(InstallTemp, FileAddress, Task)
|
||||
Task.Progress = 0.5
|
||||
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
|
||||
Task.Progress = 0.6
|
||||
'复制结果
|
||||
If Directory.Exists(InstallTemp & ArchiveBaseFolder & ".minecraft") Then
|
||||
CopyDirectory(InstallTemp & ArchiveBaseFolder & ".minecraft", PathMcFolder & "versions\" & VersionName)
|
||||
CopyDirectory(InstallTemp & ArchiveBaseFolder & ".minecraft", PathMcFolder & "versions\" & VersionName, Sub(Delta) Task.Progress += Delta * 0.35)
|
||||
Else
|
||||
Log("[ModPack] 整合包中未找到 override .minecraft 目录,已跳过")
|
||||
End If
|
||||
Task.Progress = 0.9
|
||||
Task.Progress = 0.95
|
||||
'开启版本隔离
|
||||
WriteIni(SetupFile, "VersionArgumentIndie", 1)
|
||||
'读取 MMC 设置文件(#2655)
|
||||
@@ -683,10 +648,7 @@ Retry:
|
||||
End Try
|
||||
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
|
||||
'构造版本安装请求
|
||||
If PackJson("components") Is Nothing Then
|
||||
Hint("该整合包未提供游戏版本信息,无法安装!", HintType.Critical)
|
||||
Exit Sub
|
||||
End If
|
||||
If PackJson("components") Is Nothing Then Throw New Exception("该 MMC 整合包未提供游戏版本信息,无法安装!")
|
||||
Dim Request As New McInstallRequest With {.TargetVersionName = VersionName, .TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\"}
|
||||
For Each Component In PackJson("components")
|
||||
Select Case If(Component("uid"), "").ToString
|
||||
@@ -702,12 +664,11 @@ Retry:
|
||||
Request.FabricVersion = Component("version")
|
||||
Case "org.quiltmc.quilt-loader" 'eg. 1.0.0
|
||||
Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical)
|
||||
Exit Sub
|
||||
Throw New CancelledException
|
||||
End Select
|
||||
Next
|
||||
'构造加载器
|
||||
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
|
||||
If MergeLoaders Is Nothing Then Exit Sub
|
||||
'构造 Libraries 加载器
|
||||
Dim LoadersLib As New List(Of LoaderBase)
|
||||
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
|
||||
@@ -720,54 +681,54 @@ Retry:
|
||||
|
||||
'重复任务检查
|
||||
Dim LoaderName As String = "MMC 整合包安装:" & VersionName & " "
|
||||
SyncLock LoaderTaskbarLock
|
||||
For i = 0 To LoaderTaskbar.Count - 1
|
||||
If LoaderTaskbar(i).Name = LoaderName Then
|
||||
Hint("该整合包正在安装中!", HintType.Critical)
|
||||
Exit Sub
|
||||
End If
|
||||
Next
|
||||
End SyncLock
|
||||
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
|
||||
Hint("该整合包正在安装中!", HintType.Critical)
|
||||
Throw New CancelledException
|
||||
End If
|
||||
|
||||
'启动
|
||||
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
|
||||
Loader.Start(Request.TargetVersionFolder)
|
||||
LoaderTaskbarAdd(Loader)
|
||||
FrmMain.BtnExtraDownload.ShowRefresh()
|
||||
FrmMain.BtnExtraDownload.Ribble()
|
||||
End Sub
|
||||
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
|
||||
Return Loader
|
||||
End Function
|
||||
|
||||
'MCBBS
|
||||
Private Sub InstallPackMCBBS(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String)
|
||||
Private Function InstallPackMCBBS(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String,
|
||||
Optional VersionName As String = Nothing) As LoaderCombo(Of String)
|
||||
'读取 Json 文件
|
||||
Dim Json As JObject
|
||||
Try
|
||||
Dim Entry = If(Archive.GetEntry(ArchiveBaseFolder & "mcbbs.packmeta"), Archive.GetEntry(ArchiveBaseFolder & "manifest.json"))
|
||||
Json = GetJson(ReadFile(Entry.Open, Encoding.UTF8))
|
||||
Catch ex As Exception
|
||||
Log(ex, "整合包安装信息存在问题", LogLevel.Hint)
|
||||
Exit Sub
|
||||
Throw New Exception("MCBBS 整合包安装信息存在问题", ex)
|
||||
End Try
|
||||
'获取版本名
|
||||
Dim PackName As String = If(Json("name"), "")
|
||||
Dim Validate As New ValidateFolderName(PathMcFolder & "versions")
|
||||
If Validate.Validate(PackName) <> "" Then PackName = ""
|
||||
Dim VersionName As String = MyMsgBoxInput("输入版本名称", "", PackName, New ObjectModel.Collection(Of Validate) From {Validate})
|
||||
If VersionName Is Nothing Then Exit Sub
|
||||
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
|
||||
End If
|
||||
'解压与配置文件
|
||||
Dim InstallTemp As String = PathTemp & "PackInstall\" & RandomInteger(0, 100000) & "\"
|
||||
Dim InstallLoaders As New List(Of LoaderBase)
|
||||
InstallLoaders.Add(New LoaderTask(Of String, Integer)("解压整合包文件",
|
||||
Sub(Task As LoaderTask(Of String, Integer))
|
||||
UnpackFiles(InstallTemp, FileAddress, Task)
|
||||
Task.Progress = 0.5
|
||||
ExtractModpackFiles(InstallTemp, FileAddress, Task, 0.6)
|
||||
Task.Progress = 0.6
|
||||
'复制结果
|
||||
If Directory.Exists(InstallTemp & ArchiveBaseFolder & "overrides") Then
|
||||
CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName)
|
||||
CopyDirectory(InstallTemp & ArchiveBaseFolder & "overrides", PathMcFolder & "versions\" & VersionName,
|
||||
Sub(Delta) Task.Progress += 0.35 * Delta)
|
||||
Else
|
||||
Log("[ModPack] 整合包中未找到 overrides 目录,已跳过")
|
||||
End If
|
||||
Task.Progress = 0.9
|
||||
Task.Progress = 0.95
|
||||
'开启版本隔离
|
||||
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionArgumentIndie", 1)
|
||||
End Sub) With {.ProgressWeight = New FileInfo(FileAddress).Length / 1024 / 1024 / 6, .Block = False}) '每 6M 需要 1s
|
||||
@@ -780,21 +741,15 @@ Retry:
|
||||
WriteIni(PathMcFolder & "versions\" & VersionName & "\PCL\Setup.ini", "VersionAdvanceGame", launchArgument)
|
||||
End If
|
||||
'构造加载器
|
||||
If Json("addons") Is Nothing Then
|
||||
Hint("该整合包未提供游戏版本附加信息,无法安装!", HintType.Critical)
|
||||
Exit Sub
|
||||
End If
|
||||
If Json("addons") Is Nothing Then Throw New Exception("该 MCBBS 整合包未提供游戏版本附加信息,无法安装!")
|
||||
Dim Addons As New Dictionary(Of String, String)
|
||||
For Each Entry In Json("addons")
|
||||
Addons.Add(Entry("id"), Entry("version"))
|
||||
Next
|
||||
If Not Addons.ContainsKey("game") Then
|
||||
Hint("该整合包未提供游戏版本信息,无法安装!", HintType.Critical)
|
||||
Exit Sub
|
||||
End If
|
||||
If Not Addons.ContainsKey("game") Then Throw New Exception("该 MCBBS 整合包未提供游戏版本信息,无法安装!")
|
||||
If Addons.ContainsKey("quilt") Then
|
||||
Hint("PCL 暂不支持安装需要 Quilt 的整合包!", HintType.Critical)
|
||||
Exit Sub
|
||||
Throw New CancelledException
|
||||
End If
|
||||
Dim Request As New McInstallRequest With {
|
||||
.TargetVersionName = VersionName,
|
||||
@@ -806,7 +761,6 @@ Retry:
|
||||
.FabricVersion = If(Addons.ContainsKey("fabric"), Addons("fabric"), Nothing)
|
||||
}
|
||||
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
|
||||
If MergeLoaders Is Nothing Then Exit Sub
|
||||
'构造 Libraries 加载器
|
||||
Dim LoadersLib As New List(Of LoaderBase)
|
||||
LoadersLib.Add(New LoaderTask(Of String, List(Of NetFile))("分析游戏支持库文件(副加载器)", Sub(Task As LoaderTask(Of String, List(Of NetFile))) Task.Output = McLibFix(New McVersion(VersionName))) With {.ProgressWeight = 1, .Show = False})
|
||||
@@ -819,14 +773,10 @@ Retry:
|
||||
|
||||
'重复任务检查
|
||||
Dim LoaderName As String = "MCBBS 整合包安装:" & VersionName & " "
|
||||
SyncLock LoaderTaskbarLock
|
||||
For i = 0 To LoaderTaskbar.Count - 1
|
||||
If LoaderTaskbar(i).Name = LoaderName Then
|
||||
Hint("该整合包正在安装中!", HintType.Critical)
|
||||
Exit Sub
|
||||
End If
|
||||
Next
|
||||
End SyncLock
|
||||
If LoaderTaskbar.Any(Function(l) l.Name = LoaderName) Then
|
||||
Hint("该整合包正在安装中!", HintType.Critical)
|
||||
Throw New CancelledException
|
||||
End If
|
||||
|
||||
'启动
|
||||
Dim Loader As New LoaderCombo(Of String)(LoaderName, Loaders) With {.OnStateChanged = AddressOf McInstallState}
|
||||
@@ -834,28 +784,110 @@ Retry:
|
||||
Loader.Start(Request.TargetVersionFolder)
|
||||
LoaderTaskbarAdd(Loader)
|
||||
FrmMain.BtnExtraDownload.ShowRefresh()
|
||||
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.DownloadManager))
|
||||
Return Loader
|
||||
End Function
|
||||
|
||||
'带启动器的压缩包
|
||||
Private Function InstallPackLauncherPack(FileAddress As String, Archive As Compression.ZipArchive, ArchiveBaseFolder As String) As LoaderCombo(Of String)
|
||||
'获取解压路径
|
||||
MyMsgBox("接下来请选择一个空文件夹,它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
|
||||
Dim TargetFolder As String = SelectFolder("选择安装目标(必须是一个空文件夹)")
|
||||
If String.IsNullOrEmpty(TargetFolder) Then Throw New CancelledException
|
||||
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号!", HintType.Critical) : Throw New CancelledException
|
||||
If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标!", HintType.Critical) : Throw New CancelledException
|
||||
'解压
|
||||
Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
|
||||
New LoaderTask(Of String, Integer)("解压压缩包",
|
||||
Sub(Task As LoaderTask(Of String, Integer))
|
||||
ExtractModpackFiles(TargetFolder, FileAddress, Task, 0.9)
|
||||
Thread.Sleep(400) '避免文件争用
|
||||
'查找解压后的 exe 文件
|
||||
Dim Launcher As String = Nothing
|
||||
For Each ExeFile In Directory.GetFiles(TargetFolder, "*.exe", SearchOption.TopDirectoryOnly)
|
||||
Dim Info = FileVersionInfo.GetVersionInfo(ExeFile)
|
||||
Log($"[Modpack] 文件 {ExeFile} 的产品名标识为 {Info.ProductName}")
|
||||
If Info.ProductName = "Plain Craft Launcher" Then
|
||||
Launcher = ExeFile
|
||||
Log($"[Modpack] 发现整合包附带的 PCL 启动器:{ExeFile}")
|
||||
ElseIf (Info.ProductName.ContainsF("Launcher", True) OrElse Info.ProductName.ContainsF("启动", True)) AndAlso
|
||||
Not Info.ProductName = "Plain Craft Launcher Admin Manager" Then
|
||||
If Launcher Is Nothing Then
|
||||
Launcher = ExeFile
|
||||
Log($"[Modpack] 发现整合包附带的疑似第三方启动器:{ExeFile}")
|
||||
End If
|
||||
End If
|
||||
Next
|
||||
Task.Progress = 0.95
|
||||
'尝试使用附带的启动器打开
|
||||
If Launcher IsNot Nothing Then
|
||||
Log("[Modpack] 找到压缩包中附带的启动器:" & Launcher)
|
||||
If MyMsgBox($"整合包中似乎自带了启动器,是否换用它继续安装?{vbCrLf}通常推荐这样做,以获得最佳体验。{vbCrLf}即将打开:{Launcher}", "换用整合包启动器?", "继续", "取消") = 1 Then
|
||||
ShellOnly(Launcher, "--wait")
|
||||
Log("[Modpack] 为换用整合包中的启动器启动,强制结束程序")
|
||||
FrmMain.EndProgram(False)
|
||||
Return
|
||||
End If
|
||||
Else
|
||||
Log("[Modpack] 未找到压缩包中附带的启动器")
|
||||
End If
|
||||
'加入文件夹列表
|
||||
Dim VersionName As String = GetFolderNameFromPath(TargetFolder)
|
||||
PageSelectLeft.AddFolder(
|
||||
TargetFolder & ArchiveBaseFolder.Replace("/", "\").TrimStart("\"), '格式例如:包裹文件夹\.minecraft\(最短为空字符串)
|
||||
VersionName, False)
|
||||
'调用 modpack 文件进行安装
|
||||
Dim ModpackFile = Directory.GetFiles(TargetFolder, "modpack.*", SearchOption.AllDirectories).First
|
||||
Log("[Modpack] 调用 modpack 文件继续安装:" & ModpackFile)
|
||||
ModpackInstall(ModpackFile, VersionName)
|
||||
End Sub)
|
||||
})
|
||||
Loader.Start(TargetFolder)
|
||||
LoaderTaskbarAdd(Loader)
|
||||
FrmMain.BtnExtraDownload.ShowRefresh()
|
||||
FrmMain.BtnExtraDownload.Ribble()
|
||||
End Sub
|
||||
Return Loader
|
||||
End Function
|
||||
|
||||
'普通压缩包
|
||||
Private Sub InstallPackCompress(FileAddress As String, ArchiveBaseFolder As String)
|
||||
MyMsgBox("请在接下来打开的窗口中选择安装目标文件夹,它必须是一个空文件夹。", "安装提示", "继续", ForceWait:=True)
|
||||
Private Function InstallPackCompress(FileAddress As String, Archive As Compression.ZipArchive) As LoaderCombo(Of String)
|
||||
'尝试定位 .minecraft 文件夹:寻找形如 “/versions/XXX/XXX.json” 的路径
|
||||
Dim Match As RegularExpressions.Match = Nothing
|
||||
Dim Regex As New RegularExpressions.Regex("^.*\/(?=versions\/(?<ver>[^\/]+)\/(\k<ver>)\.json$)", RegularExpressions.RegexOptions.IgnoreCase)
|
||||
For Each Entry In Archive.Entries
|
||||
Dim EntryMatch = Regex.Match("/" & Entry.FullName)
|
||||
If EntryMatch.Success Then
|
||||
Match = EntryMatch
|
||||
Exit For
|
||||
End If
|
||||
Next
|
||||
If Match Is Nothing Then Throw New Exception("未能找到适合的文件结构,这可能不是一个 MC 压缩包") '没有匹配
|
||||
Dim ArchiveBaseFolder As String = Match.Value.Replace("/", "\").TrimStart("\") '格式例如:包裹文件夹\.minecraft\(最短为空字符串)
|
||||
Dim VersionName As String = Match.Groups(1).Value
|
||||
Log("[ModPack] 检测到压缩包的 .minecraft 根目录:" & ArchiveBaseFolder & ",命中的版本名:" & VersionName)
|
||||
'获取解压路径
|
||||
MyMsgBox("接下来请选择一个空文件夹,它会被安装到这个文件夹里。", "安装", "继续", ForceWait:=True)
|
||||
Dim TargetFolder As String = SelectFolder("选择安装目标(必须是一个空文件夹)")
|
||||
If String.IsNullOrEmpty(TargetFolder) Then Exit Sub
|
||||
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号!", HintType.Critical) : Exit Sub
|
||||
If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标!", HintType.Critical) : Exit Sub
|
||||
'要求显示名称
|
||||
Dim NewName As String = MyMsgBoxInput("输入显示名称", "输入该文件夹在左边栏列表中显示的名称。", GetFolderNameFromPath(TargetFolder),
|
||||
New ObjectModel.Collection(Of Validate) From {New ValidateNullOrWhiteSpace, New ValidateLength(1, 30), New ValidateExcept({">", "|"})})
|
||||
If String.IsNullOrWhiteSpace(NewName) Then Exit Sub
|
||||
If String.IsNullOrEmpty(TargetFolder) Then Throw New CancelledException
|
||||
If TargetFolder.Contains("!") OrElse TargetFolder.Contains(";") Then Hint("Minecraft 文件夹路径中不能含有感叹号或分号!", HintType.Critical) : Throw New CancelledException
|
||||
If Directory.GetFileSystemEntries(TargetFolder).Length > 0 Then Hint("请选择一个空文件夹作为安装目标!", HintType.Critical) : Throw New CancelledException
|
||||
'解压
|
||||
Hint("正在解压压缩包……")
|
||||
UnpackFiles(TargetFolder, FileAddress, Nothing)
|
||||
'加入文件夹列表
|
||||
PageSelectLeft.AddFolder(TargetFolder, NewName, False)
|
||||
Hint("已加入游戏文件夹列表:" & NewName, HintType.Finish)
|
||||
End Sub
|
||||
Dim Loader As New LoaderCombo(Of String)("解压压缩包", {
|
||||
New LoaderTask(Of String, Integer)("解压压缩包",
|
||||
Sub(Task As LoaderTask(Of String, Integer))
|
||||
ExtractModpackFiles(TargetFolder, FileAddress, Task, 0.95)
|
||||
'加入文件夹列表
|
||||
PageSelectLeft.AddFolder(TargetFolder & ArchiveBaseFolder, GetFolderNameFromPath(TargetFolder), False)
|
||||
Thread.Sleep(400) '避免文件争用
|
||||
RunInUi(Sub() FrmMain.PageChange(FormMain.PageType.VersionSelect))
|
||||
End Sub)
|
||||
}) With {.OnStateChanged = AddressOf McInstallState}
|
||||
Loader.Start(TargetFolder)
|
||||
LoaderTaskbarAdd(Loader)
|
||||
FrmMain.BtnExtraDownload.ShowRefresh()
|
||||
FrmMain.BtnExtraDownload.Ribble()
|
||||
Return Loader
|
||||
End Function
|
||||
|
||||
#End Region
|
||||
|
||||
|
||||
@@ -88,26 +88,27 @@
|
||||
AddHandler GameProcess.ErrorDataReceived, AddressOf LogReceived
|
||||
|
||||
'初始化时钟
|
||||
RunInNewThread(Sub()
|
||||
Try
|
||||
Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Crashed OrElse State = MinecraftState.Canceled OrElse Loader.State = LoadState.Aborted
|
||||
TimerWindow()
|
||||
TimerLog()
|
||||
'设置窗口标题
|
||||
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"))
|
||||
SetWindowText(WindowHandle, RealTitle.ToCharArray)
|
||||
End If
|
||||
Thread.Sleep(64)
|
||||
Next
|
||||
Loop
|
||||
WatcherLog("Minecraft 日志监控已退出")
|
||||
Catch ex As Exception
|
||||
Log(ex, "Minecraft 日志监控主循环出错", LogLevel.Feedback)
|
||||
State = MinecraftState.Ended
|
||||
End Try
|
||||
End Sub, "Minecraft Watcher PID " & PID)
|
||||
RunInNewThread(
|
||||
Sub()
|
||||
Try
|
||||
Do Until State = MinecraftState.Ended OrElse State = MinecraftState.Crashed OrElse State = MinecraftState.Canceled OrElse Loader.State = LoadState.Aborted
|
||||
TimerWindow()
|
||||
TimerLog()
|
||||
'设置窗口标题
|
||||
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"))
|
||||
SetWindowText(WindowHandle, RealTitle.ToCharArray)
|
||||
End If
|
||||
Thread.Sleep(64)
|
||||
Next
|
||||
Loop
|
||||
WatcherLog("Minecraft 日志监控已退出")
|
||||
Catch ex As Exception
|
||||
Log(ex, "Minecraft 日志监控主循环出错", LogLevel.Feedback)
|
||||
State = MinecraftState.Ended
|
||||
End Try
|
||||
End Sub, "Minecraft Watcher PID " & PID)
|
||||
End Sub
|
||||
|
||||
'状态
|
||||
@@ -349,22 +350,21 @@
|
||||
WatcherLog("Minecraft 已崩溃,将在 2 秒后开始崩溃分析")
|
||||
Hint("检测到 Minecraft 出现错误,错误分析已开始……")
|
||||
FeedbackInfo()
|
||||
RunInNewThread(Sub()
|
||||
Try
|
||||
Thread.Sleep(2000)
|
||||
WatcherLog("崩溃分析开始")
|
||||
Dim Analyzer As New CrashAnalyzer(PID)
|
||||
Analyzer.Collect(Version.PathIndie, LatestLog.ToList)
|
||||
Analyzer.Prepare()
|
||||
Analyzer.Analyze(Version)
|
||||
Analyzer.Output(False, New List(Of String) From
|
||||
{Version.Path & Version.Name & ".json",
|
||||
Path & "PCL\Log1.txt",
|
||||
Path & "PCL\LatestLaunch.bat"})
|
||||
Catch ex As Exception
|
||||
Log(ex, "崩溃分析失败", LogLevel.Feedback)
|
||||
End Try
|
||||
End Sub, "Crash Analyzer")
|
||||
RunInNewThread(
|
||||
Sub()
|
||||
Try
|
||||
Thread.Sleep(2000)
|
||||
WatcherLog("崩溃分析开始")
|
||||
Dim Analyzer As New CrashAnalyzer(PID)
|
||||
Analyzer.Collect(Version.PathIndie, LatestLog.ToList)
|
||||
Analyzer.Prepare()
|
||||
Analyzer.Analyze(Version)
|
||||
Analyzer.Output(False, New List(Of String) From
|
||||
{Version.Path & Version.Name & ".json", Path & "PCL\Log1.txt", Path & "PCL\LatestLaunch.bat"})
|
||||
Catch ex As Exception
|
||||
Log(ex, "崩溃分析失败", LogLevel.Feedback)
|
||||
End Try
|
||||
End Sub, "Crash Analyzer")
|
||||
End Sub
|
||||
|
||||
'强制关闭
|
||||
|
||||
@@ -1,6 +1,7 @@
|
||||
<Grid x:Class="MyCompItem"
|
||||
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
|
||||
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
|
||||
xmlns:local="clr-namespace:PCL"
|
||||
x:Name="PanBack" Height="64"
|
||||
RenderTransformOrigin="0.5,0.5" Background="{StaticResource ColorBrushSemiTransparent}" SnapsToDevicePixels="True">
|
||||
<Grid.ColumnDefinitions>
|
||||
@@ -23,7 +24,7 @@
|
||||
<Border.Clip>
|
||||
<RectangleGeometry Rect="0,0,50,50" RadiusX="6" RadiusY="6" />
|
||||
</Border.Clip>
|
||||
<Image x:Name="PathLogo" RenderOptions.BitmapScalingMode="HighQuality" />
|
||||
<local:MyImage x:Name="PathLogo" RenderOptions.BitmapScalingMode="HighQuality" FallbackSource="pack://application:,,,/images/Icons/NoIcon.png" />
|
||||
</Border>
|
||||
<!-- 标题 -->
|
||||
<StackPanel Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0" Orientation="Horizontal"
|
||||
|
||||
@@ -4,90 +4,14 @@
|
||||
Public Uuid As Integer = GetUuid()
|
||||
|
||||
'Logo
|
||||
Private _Logo As String = ""
|
||||
Public Property Logo As String
|
||||
Get
|
||||
Return _Logo
|
||||
Return PathLogo.Source
|
||||
End Get
|
||||
Set(value As String)
|
||||
If _Logo = value OrElse value Is Nothing Then Exit Property
|
||||
_Logo = value
|
||||
Dim FileAddress = PathTemp & "CompLogo\" & GetHash(_Logo) & ".png"
|
||||
Try
|
||||
If _Logo.StartsWithF("http", True) Then
|
||||
'网络图片
|
||||
If File.Exists(FileAddress) Then
|
||||
PathLogo.Source = New MyBitmap(FileAddress)
|
||||
ElseIf _Logo.EndsWithF(".webp", True) Then 'Modrinth 林业 Mod 使用了不支持的 WebP 格式 Logo
|
||||
Log($"[Comp] 发现不支持的 WebP 格式图标,已更改为默认图标:{_Logo}")
|
||||
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
|
||||
Else
|
||||
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
|
||||
RunInNewThread(Sub() LogoLoader(FileAddress), "Comp Logo Loader " & Uuid & "#", ThreadPriority.BelowNormal)
|
||||
End If
|
||||
Else
|
||||
'位图
|
||||
PathLogo.Source = New MyBitmap(_Logo)
|
||||
End If
|
||||
Catch ex As IOException
|
||||
Log(ex, "加载资源工程图标时读取失败(" & FileAddress & ")")
|
||||
Catch ex As ArgumentException
|
||||
'考虑缓存的图片本身可能有误
|
||||
Log(ex, "可视化资源工程图标失败(" & FileAddress & ")")
|
||||
Try
|
||||
File.Delete(FileAddress)
|
||||
Log("[Comp] 已清理损坏的资源工程图标:" & FileAddress)
|
||||
Catch exx As Exception
|
||||
Log(exx, "清理损坏的资源工程图标缓存失败(" & FileAddress & ")", LogLevel.Hint)
|
||||
End Try
|
||||
Catch ex As Exception
|
||||
Log(ex, "加载资源工程图标失败(" & value & ")")
|
||||
End Try
|
||||
PathLogo.Source = value
|
||||
End Set
|
||||
End Property
|
||||
'后台加载 Logo
|
||||
Private Sub LogoLoader(LocalFileAddress As String)
|
||||
Dim Retried As Boolean = False
|
||||
Dim DownloadEnd As String = GetUuid()
|
||||
RetryStart:
|
||||
Try
|
||||
'CurseForge 图片使用缩略图
|
||||
Dim Url As String = _Logo
|
||||
If Url.Contains("/256/256/") AndAlso GetPixelSize(1) <= 1.25 AndAlso Not Retried Then
|
||||
Url = Url.Replace("/256/256/", "/64/64/") '#3075:部分 Mod 不存在 64x64 图标,所以重试时不再缩小
|
||||
End If
|
||||
'下载图片
|
||||
NetDownload(Url, LocalFileAddress & DownloadEnd, True)
|
||||
Dim LoadError As Exception = Nothing
|
||||
RunInUiWait(
|
||||
Sub()
|
||||
Try
|
||||
'在地址更换时取消加载
|
||||
If LocalFileAddress <> $"{PathTemp}CompLogo\{GetHash(_Logo)}.png" Then Exit Sub
|
||||
'在完成正常加载后才保存缓存图片
|
||||
PathLogo.Source = New MyBitmap(LocalFileAddress & DownloadEnd)
|
||||
Catch ex As Exception
|
||||
Log(ex, $"读取资源工程图标失败({LocalFileAddress})")
|
||||
File.Delete(LocalFileAddress & DownloadEnd)
|
||||
LoadError = ex
|
||||
End Try
|
||||
End Sub)
|
||||
If LoadError IsNot Nothing Then Throw LoadError
|
||||
If File.Exists(LocalFileAddress) Then
|
||||
File.Delete(LocalFileAddress & DownloadEnd)
|
||||
Else
|
||||
FileIO.FileSystem.MoveFile(LocalFileAddress & DownloadEnd, LocalFileAddress)
|
||||
End If
|
||||
Catch ex As Exception
|
||||
If Not Retried Then
|
||||
Retried = True
|
||||
GoTo RetryStart
|
||||
Else
|
||||
Log(ex, $"下载资源工程图标失败({_Logo})")
|
||||
RunInUi(Sub() PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png"))
|
||||
End If
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
'标题
|
||||
Public Property Title As String
|
||||
@@ -172,7 +96,7 @@ RetryStart:
|
||||
'记录当前展开的卡片标题(#2712)
|
||||
Dim Titles As New List(Of String)
|
||||
If FrmMain.PageCurrent.Page = FormMain.PageType.CompDetail Then
|
||||
For Each Card As MyCard In FrmDownloadCompDetail.PanMain.Children
|
||||
For Each Card As MyCard In FrmDownloadCompDetail.PanResults.Children
|
||||
If Card.Title <> "" AndAlso Not Card.IsSwaped Then Titles.Add(Card.Title)
|
||||
Next
|
||||
Log("[Comp] 记录当前已展开的卡片:" & String.Join("、", Titles))
|
||||
|
||||
@@ -24,30 +24,27 @@
|
||||
<Border.Clip>
|
||||
<RectangleGeometry Rect="0,0,34,34" RadiusX="6" RadiusY="6" />
|
||||
</Border.Clip>
|
||||
<Image x:Name="PathLogo" RenderOptions.BitmapScalingMode="HighQuality" />
|
||||
<local:MyImage x:Name="PathLogo" RenderOptions.BitmapScalingMode="HighQuality" FallbackSource="pack://application:,,,/images/Icons/NoIcon.png" />
|
||||
</Border>
|
||||
<!-- 标题 -->
|
||||
<StackPanel Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0" Orientation="Horizontal"
|
||||
SnapsToDevicePixels="False" UseLayoutRounding="False">
|
||||
<TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" IsHitTestVisible="False" />
|
||||
<TextBlock x:Name="LabTitleRaw" TextTrimming="WordEllipsis" FontSize="12" IsHitTestVisible="False"
|
||||
<Grid Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0"
|
||||
SnapsToDevicePixels="False" UseLayoutRounding="False" x:Name="PanTitle">
|
||||
<Grid.ColumnDefinitions>
|
||||
<ColumnDefinition Width="Auto" x:Name="ColumnTitle" />
|
||||
<ColumnDefinition Width="Auto" x:Name="ColumnSubtitle" />
|
||||
<ColumnDefinition Width="Auto" />
|
||||
<ColumnDefinition Width="1*" x:Name="ColumnExtend" />
|
||||
</Grid.ColumnDefinitions>
|
||||
<TextBlock x:Name="LabTitle" TextTrimming="CharacterEllipsis" FontSize="14" IsHitTestVisible="False" />
|
||||
<TextBlock x:Name="LabSubtitle" Grid.Column="1" HorizontalAlignment="Left"
|
||||
TextTrimming="CharacterEllipsis" FontSize="12" IsHitTestVisible="False"
|
||||
Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" />
|
||||
<!-- 更新按钮 -->
|
||||
<local:MyIconButton Width="21" Height="21" Margin="-2,-1.6,0,0" x:Name="BtnUpdate" Theme="Black" Opacity="0.4" Visibility="Collapsed"
|
||||
<local:MyIconButton Grid.Column="2"
|
||||
Width="21" Height="21" Margin="-2,-1.6,0,0" x:Name="BtnUpdate" Theme="Black" Opacity="0.4" Visibility="Collapsed"
|
||||
ToolTipService.Placement="Right" ToolTipService.InitialShowDelay="100" ToolTipService.VerticalOffset="-9"
|
||||
Logo="M640 768H384l-32-32V509H213L190 454l298-298h45l298 298L810 509h-138v226z m-224-64h192V477l32-32h93L512 223 290 445H384l32 32zM352 831h320v64h-320z" />
|
||||
</StackPanel>
|
||||
<!--<Grid Grid.Column="3" Grid.ColumnSpan="2" Grid.Row="1" VerticalAlignment="Bottom" Margin="0,1,0,0" IsHitTestVisible="False" SnapsToDevicePixels="False" UseLayoutRounding="False">
|
||||
<Grid.ColumnDefinitions>
|
||||
<ColumnDefinition Width="Auto" />
|
||||
<ColumnDefinition Width="1*" />
|
||||
<ColumnDefinition Width="Auto" />
|
||||
</Grid.ColumnDefinitions>
|
||||
<TextBlock x:Name="LabTitle" TextTrimming="WordEllipsis" FontSize="14" Grid.Column="0" />
|
||||
<TextBlock x:Name="LabTitleRaw" TextTrimming="WordEllipsis" FontSize="12" Grid.Column="1"
|
||||
Foreground="{StaticResource ColorBrushGray1}" Opacity="0.4" VerticalAlignment="Bottom" Visibility="Collapsed" />
|
||||
<local:MyIconTextButton Grid.Column="2" Text="更新" />
|
||||
</Grid>-->
|
||||
</Grid>
|
||||
<!-- Tag 与 详情 -->
|
||||
<StackPanel x:Name="PanTags" Grid.Row="2" Grid.Column="3" Orientation="Horizontal" VerticalAlignment="Bottom" Margin="-1,0,1,0" Visibility="Collapsed" IsHitTestVisible="False">
|
||||
<!--<Border Background="{DynamicResource ColorBrush6}" Padding="3,1" CornerRadius="3" Margin="0,0,4,0" SnapsToDevicePixels="True" UseLayoutRounding="False">
|
||||
@@ -55,6 +52,6 @@
|
||||
</Border>-->
|
||||
</StackPanel>
|
||||
<TextBlock x:Name="LabInfo" Grid.Row="2" Grid.Column="4" VerticalAlignment="Bottom" Margin="0,0,3,1"
|
||||
TextTrimming="CharacterEllipsis" FontSize="12" Foreground="{StaticResource ColorBrushGray3}"
|
||||
TextTrimming="CharacterEllipsis" FontSize="12" Foreground="{StaticResource ColorBrushGray4}"
|
||||
IsHitTestVisible="False" SnapsToDevicePixels="False" UseLayoutRounding="False" />
|
||||
</Grid>
|
||||
|
||||
@@ -6,90 +6,14 @@ Public Class MyLocalModItem
|
||||
Public Uuid As Integer = GetUuid()
|
||||
|
||||
'Logo
|
||||
Private _Logo As String = ""
|
||||
Public Property Logo As String
|
||||
Get
|
||||
Return _Logo
|
||||
Return PathLogo.Source
|
||||
End Get
|
||||
Set(value As String)
|
||||
If _Logo = value OrElse value Is Nothing Then Exit Property
|
||||
_Logo = value
|
||||
Dim FileAddress = PathTemp & "CompLogo\" & GetHash(_Logo) & ".png"
|
||||
Try
|
||||
If _Logo.StartsWithF("http", True) Then
|
||||
'网络图片
|
||||
If File.Exists(FileAddress) Then
|
||||
PathLogo.Source = New MyBitmap(FileAddress)
|
||||
ElseIf _Logo.EndsWithF(".webp", True) Then 'Modrinth 林业 Mod 使用了不支持的 WebP 格式 Logo
|
||||
Log($"[LocalModItem] 发现不支持的 WebP 格式图标,已更改为默认图标:{_Logo}")
|
||||
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
|
||||
Else
|
||||
PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png")
|
||||
RunInNewThread(Sub() LogoLoader(FileAddress), "Comp Logo Loader " & Uuid & "#", ThreadPriority.BelowNormal)
|
||||
End If
|
||||
Else
|
||||
'位图
|
||||
PathLogo.Source = New MyBitmap(_Logo)
|
||||
End If
|
||||
Catch ex As IOException
|
||||
Log(ex, "加载本地 Mod 图标时读取失败(" & FileAddress & ")")
|
||||
Catch ex As ArgumentException
|
||||
'考虑缓存的图片本身可能有误
|
||||
Log(ex, "可视化本地 Mod 图标失败(" & FileAddress & ")")
|
||||
Try
|
||||
File.Delete(FileAddress)
|
||||
Log("[LocalModItem] 已清理损坏的本地 Mod 图标:" & FileAddress)
|
||||
Catch exx As Exception
|
||||
Log(exx, "清理损坏的本地 Mod 图标缓存失败(" & FileAddress & ")", LogLevel.Hint)
|
||||
End Try
|
||||
Catch ex As Exception
|
||||
Log(ex, "加载本地 Mod 图标失败(" & value & ")")
|
||||
End Try
|
||||
PathLogo.Source = value
|
||||
End Set
|
||||
End Property
|
||||
'后台加载 Logo
|
||||
Private Sub LogoLoader(LocalFileAddress As String)
|
||||
Dim Retried As Boolean = False
|
||||
Dim DownloadEnd As String = GetUuid()
|
||||
RetryStart:
|
||||
Try
|
||||
'CurseForge 图片使用缩略图
|
||||
Dim Url As String = _Logo
|
||||
If Url.Contains("/256/256/") AndAlso GetPixelSize(1) <= 1.25 AndAlso Not Retried Then
|
||||
Url = Url.Replace("/256/256/", "/64/64/") '#3075:部分 Mod 不存在 64x64 图标,所以重试时不再缩小
|
||||
End If
|
||||
'下载图片
|
||||
NetDownload(Url, LocalFileAddress & DownloadEnd, True)
|
||||
Dim LoadError As Exception = Nothing
|
||||
RunInUiWait(
|
||||
Sub()
|
||||
Try
|
||||
'在地址更换时取消加载
|
||||
If LocalFileAddress <> $"{PathTemp}CompLogo\{GetHash(_Logo)}.png" Then Exit Sub
|
||||
'在完成正常加载后才保存缓存图片
|
||||
PathLogo.Source = New MyBitmap(LocalFileAddress & DownloadEnd)
|
||||
Catch ex As Exception
|
||||
Log(ex, "读取本地 Mod 图标失败(" & LocalFileAddress & ")")
|
||||
File.Delete(LocalFileAddress & DownloadEnd)
|
||||
LoadError = ex
|
||||
End Try
|
||||
End Sub)
|
||||
If LoadError IsNot Nothing Then Throw LoadError
|
||||
If File.Exists(LocalFileAddress) Then
|
||||
File.Delete(LocalFileAddress & DownloadEnd)
|
||||
Else
|
||||
FileIO.FileSystem.MoveFile(LocalFileAddress & DownloadEnd, LocalFileAddress)
|
||||
End If
|
||||
Catch ex As Exception
|
||||
If Not Retried Then
|
||||
Retried = True
|
||||
GoTo RetryStart
|
||||
Else
|
||||
Log(ex, $"下载本地 Mod 图标失败({_Logo})")
|
||||
RunInUi(Sub() PathLogo.Source = New MyBitmap(PathImage & "Icons/NoIcon.png"))
|
||||
End If
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
'标题
|
||||
Private _Title As String
|
||||
@@ -104,7 +28,7 @@ RetryStart:
|
||||
LabTitle.TextDecorations = Nothing
|
||||
Case McMod.McModState.Disabled
|
||||
LabTitle.TextDecorations = TextDecorations.Strikethrough
|
||||
Case McMod.McModState.Unavaliable
|
||||
Case McMod.McModState.Unavailable
|
||||
LabTitle.TextDecorations = TextDecorations.Strikethrough
|
||||
value &= " [错误]"
|
||||
End Select
|
||||
@@ -117,12 +41,12 @@ RetryStart:
|
||||
'副标题
|
||||
Public Property SubTitle As String
|
||||
Get
|
||||
Return If(LabTitleRaw?.Text, "")
|
||||
Return If(LabSubtitle?.Text, "")
|
||||
End Get
|
||||
Set(value As String)
|
||||
If LabTitleRaw.Text = value Then Exit Property
|
||||
LabTitleRaw.Text = value
|
||||
LabTitleRaw.Visibility = If(value = "", Visibility.Collapsed, Visibility.Visible)
|
||||
If LabSubtitle.Text = value Then Exit Property
|
||||
LabSubtitle.Text = value
|
||||
LabSubtitle.Visibility = If(value = "", Visibility.Collapsed, Visibility.Visible)
|
||||
End Set
|
||||
End Property
|
||||
|
||||
@@ -145,9 +69,9 @@ RetryStart:
|
||||
For Each TagText In value
|
||||
Dim NewTag = GetObjectFromXML(
|
||||
"<Border xmlns=""http://schemas.microsoft.com/winfx/2006/xaml/presentation""
|
||||
Background=""#11000000"" Padding=""3,1"" CornerRadius=""3"" Margin=""0,0,3,0""
|
||||
Background=""#0C000000"" Padding=""3,1"" CornerRadius=""3"" Margin=""0,0,3,0""
|
||||
SnapsToDevicePixels=""True"" UseLayoutRounding=""False"">
|
||||
<TextBlock Text=""" & TagText & """ Foreground=""#868686"" FontSize=""11"" />
|
||||
<TextBlock Text=""" & TagText & """ Foreground=""#88000000"" FontSize=""11"" />
|
||||
</Border>")
|
||||
PanTags.Children.Add(NewTag)
|
||||
Next
|
||||
@@ -213,13 +137,14 @@ RetryStart:
|
||||
Exit Sub
|
||||
End If
|
||||
'计算滑动范围
|
||||
Dim Index = CType(Parent, StackPanel).Children.IndexOf(Me)
|
||||
SwipeStart = Math.Min(SwipeStart, Index)
|
||||
SwipeEnd = Math.Max(SwipeEnd, Index)
|
||||
Dim Elements = CType(Parent, StackPanel).Children
|
||||
Dim Index As Integer = Elements.IndexOf(Me)
|
||||
SwipeStart = MathClamp(Math.Min(SwipeStart, Index), 0, Elements.Count - 1)
|
||||
SwipeEnd = MathClamp(Math.Max(SwipeEnd, Index), 0, Elements.Count - 1)
|
||||
'勾选所有范围中的项
|
||||
If SwipeStart = SwipeEnd Then Exit Sub
|
||||
For i = SwipeStart To SwipeEnd
|
||||
Dim Item As MyLocalModItem = CType(Parent, StackPanel).Children(i)
|
||||
Dim Item As MyLocalModItem = Elements(i)
|
||||
Item.InitLate(Item, e)
|
||||
Item.Checked = SwipToState
|
||||
Next
|
||||
@@ -379,57 +304,75 @@ RetryStart:
|
||||
|
||||
#End Region
|
||||
|
||||
Public Sub Refresh()
|
||||
Private Function GetUpdateCompareDescription() As String
|
||||
Dim CurrentName = Entry.CompFile.FileName.Replace(".jar", "")
|
||||
Dim NewestName = Entry.UpdateFile.FileName.Replace(".jar", "")
|
||||
'简化名称对比
|
||||
Dim CurrentSegs = CurrentName.Split("-"c).ToList()
|
||||
Dim NewestSegs = NewestName.Split("-"c).ToList()
|
||||
Dim Shortened As Boolean = False
|
||||
For Each Seg In CurrentSegs.ToList()
|
||||
If Not NewestSegs.Contains(Seg) Then Continue For
|
||||
CurrentSegs.Remove(Seg)
|
||||
NewestSegs.Remove(Seg)
|
||||
Shortened = True
|
||||
Next
|
||||
If Shortened AndAlso CurrentSegs.Any() AndAlso NewestSegs.Any() Then
|
||||
CurrentName = Join(CurrentSegs, "-")
|
||||
NewestName = Join(NewestSegs, "-")
|
||||
Entry._Version = CurrentName '使用网络信息作为显示的版本号
|
||||
End If
|
||||
Return $"当前版本:{CurrentName}({GetTimeSpanString(Entry.CompFile.ReleaseDate - Date.Now, False)}){vbCrLf}最新版本:{NewestName}({GetTimeSpanString(Entry.UpdateFile.ReleaseDate - Date.Now, False)})"
|
||||
End Function
|
||||
Public Sub Refresh() Handles Me.Loaded
|
||||
RunInUi(
|
||||
Sub()
|
||||
'更新
|
||||
If Entry.CanUpdate Then
|
||||
BtnUpdate.Visibility = Visibility.Visible
|
||||
Dim CurrentName = Entry.CompFile.FileName.Replace(".jar", "")
|
||||
Dim NewestName = Entry.UpdateFile.FileName.Replace(".jar", "")
|
||||
'简化名称对比
|
||||
Dim CurrentSegs = CurrentName.Split("-"c).ToList()
|
||||
Dim NewestSegs = NewestName.Split("-"c).ToList()
|
||||
Dim Shortened As Boolean = False
|
||||
For Each Seg In CurrentSegs.ToList()
|
||||
If Not NewestSegs.Contains(Seg) Then Continue For
|
||||
CurrentSegs.Remove(Seg)
|
||||
NewestSegs.Remove(Seg)
|
||||
Shortened = True
|
||||
Next
|
||||
If Shortened AndAlso CurrentSegs.Any() AndAlso NewestSegs.Any() Then
|
||||
CurrentName = Join(CurrentSegs, "-")
|
||||
NewestName = Join(NewestSegs, "-")
|
||||
Entry._Version = CurrentName '使用网络信息作为显示的版本号
|
||||
End If
|
||||
BtnUpdate.ToolTip = $"当前版本:{CurrentName} ({Entry.CompFile.ReleaseDate:yyyy/MM/dd HH:mm:ss}){vbCrLf}最新版本:{NewestName} ({Entry.UpdateFile.ReleaseDate:yyyy/MM/dd HH:mm:ss}){vbCrLf}点击以更新,右键查看更新日志。"
|
||||
BtnUpdate.ToolTip = $"{GetUpdateCompareDescription()}{vbCrLf}点击以更新,右键查看更新日志。"
|
||||
Else
|
||||
BtnUpdate.Visibility = Visibility.Collapsed
|
||||
End If
|
||||
'标题
|
||||
If Entry.Comp Is Nothing Then
|
||||
Title = Entry.Name
|
||||
SubTitle = If(Entry.Version Is Nothing, "", " | " & Entry.Version)
|
||||
Else
|
||||
Dim Titles = Entry.Comp.GetControlTitle(False)
|
||||
Title = Titles.Key
|
||||
SubTitle = Titles.Value & If(Entry.Version Is Nothing, "", " | " & Entry.Version)
|
||||
End If
|
||||
If Checked Then
|
||||
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush2", "ColorBrush5"))
|
||||
Else
|
||||
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush1", "ColorBrushGray4"))
|
||||
End If
|
||||
'描述
|
||||
Dim NewDescription As String
|
||||
'标题与描述
|
||||
Dim DescFileName As String
|
||||
Select Case Entry.State
|
||||
Case McMod.McModState.Fine
|
||||
NewDescription = GetFileNameWithoutExtentionFromPath(Entry.Path)
|
||||
DescFileName = GetFileNameWithoutExtentionFromPath(Entry.Path)
|
||||
Case McMod.McModState.Disabled
|
||||
NewDescription = GetFileNameWithoutExtentionFromPath(Entry.Path.Replace(".disabled", "").Replace(".old", ""))
|
||||
Case Else 'McMod.McModState.Unavaliable
|
||||
NewDescription = GetFileNameFromPath(Entry.Path)
|
||||
DescFileName = GetFileNameWithoutExtentionFromPath(Entry.Path.Replace(".disabled", "").Replace(".old", ""))
|
||||
Case Else 'McMod.McModState.Unavailable
|
||||
DescFileName = GetFileNameFromPath(Entry.Path)
|
||||
End Select
|
||||
Dim NewDescription As String
|
||||
If Setup.Get("ToolModLocalNameStyle") = 1 Then
|
||||
'标题显示文件名,详情显示译名
|
||||
'标题
|
||||
Title = DescFileName
|
||||
SubTitle = ""
|
||||
'描述
|
||||
If Entry.Comp Is Nothing Then
|
||||
NewDescription = Entry.Name
|
||||
Else
|
||||
Dim Titles = Entry.Comp.GetControlTitle(False)
|
||||
NewDescription = Titles.Key & Titles.Value
|
||||
End If
|
||||
NewDescription = NewDescription.Replace(" | ", " / ")
|
||||
If Entry.Version IsNot Nothing Then NewDescription &= $" ({Entry.Version})"
|
||||
Else
|
||||
'标题显示译名,详情显示文件名
|
||||
'标题
|
||||
If Entry.Comp Is Nothing Then
|
||||
Title = Entry.Name
|
||||
SubTitle = If(Entry.Version Is Nothing, "", " | " & Entry.Version)
|
||||
Else
|
||||
Dim Titles = Entry.Comp.GetControlTitle(False)
|
||||
Title = Titles.Key
|
||||
SubTitle = Titles.Value & If(Entry.Version Is Nothing, "", " | " & Entry.Version)
|
||||
End If
|
||||
'描述
|
||||
NewDescription = DescFileName
|
||||
End If
|
||||
If Entry.Comp IsNot Nothing Then
|
||||
NewDescription += ": " & Entry.Comp.Description.Replace(vbCr, "").Replace(vbLf, "")
|
||||
ElseIf Entry.Description IsNot Nothing Then
|
||||
@@ -438,6 +381,11 @@ RetryStart:
|
||||
NewDescription += ": " & "存在错误,无法获取信息"
|
||||
End If
|
||||
Description = NewDescription
|
||||
If Checked Then
|
||||
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush2", "ColorBrush5"))
|
||||
Else
|
||||
LabTitle.SetResourceReference(TextBlock.ForegroundProperty, If(Entry.State = McMod.McModState.Fine, "ColorBrush1", "ColorBrushGray4"))
|
||||
End If
|
||||
'主 Logo
|
||||
Logo = If(Entry.Comp Is Nothing, PathImage & "Icons/NoIcon.png", Entry.Comp.GetControlLogo())
|
||||
'图标右下角的 Logo
|
||||
@@ -458,7 +406,7 @@ RetryStart:
|
||||
'<Image x:Name="ImgState" RenderOptions.BitmapScalingMode="HighQuality" Width="16" Height="16" Margin="0,0,-3,-1"
|
||||
' Grid.Column="1" Grid.Row="1" Grid.RowSpan="2" IsHitTestVisible="False"
|
||||
' HorizontalAlignment="Right" VerticalAlignment="Bottom"
|
||||
' Source="/Images/Icons/Unavaliable.png" />
|
||||
' Source="/Images/Icons/Unavailable.png" />
|
||||
End If
|
||||
ImgState.Source = New MyBitmap(PathImage & $"Icons/{Entry.State}.png")
|
||||
End If
|
||||
@@ -514,8 +462,11 @@ RetryStart:
|
||||
End Sub
|
||||
|
||||
'显示更新日志
|
||||
Private Sub ShowUpdateLog(sender As Object, e As MouseButtonEventArgs) Handles BtnUpdate.PreviewMouseRightButtonUp
|
||||
Private Sub BtnUpdate_PreviewMouseRightButtonUp(sender As Object, e As MouseButtonEventArgs) Handles BtnUpdate.PreviewMouseRightButtonUp
|
||||
e.Handled = True
|
||||
ShowUpdateLog()
|
||||
End Sub
|
||||
Private Sub ShowUpdateLog()
|
||||
Dim CurseForgeUrl As String = Entry.ChangelogUrls.FirstOrDefault(Function(x) x.Contains("curseforge.com"))
|
||||
Dim ModrinthUrl As String = Entry.ChangelogUrls.FirstOrDefault(Function(x) x.Contains("modrinth.com"))
|
||||
If CurseForgeUrl Is Nothing OrElse ModrinthUrl Is Nothing Then
|
||||
@@ -532,7 +483,62 @@ RetryStart:
|
||||
|
||||
'触发更新
|
||||
Private Sub BtnUpdate_Click(sender As Object, e As EventArgs) Handles BtnUpdate.Click
|
||||
FrmVersionMod.UpdateMods({Entry})
|
||||
Select Case MyMsgBox($"是否要更新 {Entry.Name}?{vbCrLf}{vbCrLf}{GetUpdateCompareDescription()}", "Mod 更新确认", "更新", "查看更新日志", "取消")
|
||||
Case 1 '更新
|
||||
FrmVersionMod.UpdateMods({Entry})
|
||||
Case 2 '查看更新日志
|
||||
ShowUpdateLog()
|
||||
Case 3 '取消
|
||||
End Select
|
||||
End Sub
|
||||
|
||||
'自适应(#4465)
|
||||
Private Sub PanTitle_SizeChanged() Handles PanTitle.SizeChanged
|
||||
'0:全部舒展:Auto - Auto - (Auto) - 1*
|
||||
'1:压缩 Subtitle:Auto - 1* - (Auto) - 0
|
||||
'2:继续压缩 Title:1* - 0 - (Auto) - 0
|
||||
Dim CurrentCompressLevel As Integer =
|
||||
If(ColumnExtend.Width.IsStar, 0, If(ColumnTitle.Width.IsStar, 2, 1)) 'Subtitle 可能是 Collapsed
|
||||
Dim NewCompressLevel As Integer
|
||||
Select Case CurrentCompressLevel
|
||||
Case 0
|
||||
If ColumnExtend.ActualWidth < 0.5 Then
|
||||
NewCompressLevel = If(LabSubtitle.Visibility = Visibility.Collapsed, 2, 1)
|
||||
Else
|
||||
Return
|
||||
End If
|
||||
Case 1
|
||||
If ColumnSubtitle.ActualWidth < 0.5 Then
|
||||
NewCompressLevel = 2
|
||||
ElseIf Not LabSubtitle.IsTextTrimmed Then
|
||||
NewCompressLevel = 0
|
||||
Else
|
||||
Return
|
||||
End If
|
||||
Case 2
|
||||
If Not LabTitle.IsTextTrimmed Then
|
||||
NewCompressLevel = If(LabSubtitle.Visibility = Visibility.Collapsed, 0, 1)
|
||||
Else
|
||||
Return
|
||||
End If
|
||||
End Select
|
||||
Select Case NewCompressLevel
|
||||
Case 0
|
||||
'全部舒展:Auto - Auto - (Auto) - 1*
|
||||
ColumnTitle.Width = GridLength.Auto
|
||||
ColumnSubtitle.Width = GridLength.Auto
|
||||
ColumnExtend.Width = New GridLength(1, GridUnitType.Star)
|
||||
Case 1
|
||||
'压缩 Subtitle:Auto - 1* - (Auto) - 0
|
||||
ColumnTitle.Width = GridLength.Auto
|
||||
ColumnSubtitle.Width = New GridLength(1, GridUnitType.Star)
|
||||
ColumnExtend.Width = New GridLength(0, GridUnitType.Pixel)
|
||||
Case 2
|
||||
'继续压缩 Title:1* - 0 - (Auto) - 0
|
||||
ColumnTitle.Width = New GridLength(1, GridUnitType.Star)
|
||||
ColumnSubtitle.Width = New GridLength(0, GridUnitType.Pixel)
|
||||
ColumnExtend.Width = New GridLength(0, GridUnitType.Pixel)
|
||||
End Select
|
||||
End Sub
|
||||
|
||||
End Class
|
||||
|
||||
Reference in New Issue
Block a user