Merge branch 'main' into resourcepacks

This commit is contained in:
Pigeon0v0
2024-07-11 20:38:14 +08:00
committed by GitHub
57 changed files with 1832 additions and 1060 deletions
+94 -71
View File
@@ -11,12 +11,12 @@ Public Module ModBase
#Region "声明"
'下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.7.4" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.7.4." & VersionBranchCode '标准格式的四段式版本号
Public Const VersionBaseName As String = "2.8.2" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.8.2." & VersionBranchCode '标准格式的四段式版本号
#If BETA Then
Public Const VersionCode As Integer = 323 'Release
Public Const VersionCode As Integer = 330 'Release
#Else
Public Const VersionCode As Integer = 325 'Snapshot
Public Const VersionCode As Integer = 329 'Snapshot
#End If
'自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -86,7 +86,7 @@ Public Module ModBase
''' <summary>
''' 系统盘盘符,以 \ 结尾。例如 “C:\”。
''' </summary>
Public OsDrive As String = Environment.GetLogicalDrives().First.ToUpper.First & ":\"
Public OsDrive As String = Environment.GetLogicalDrives().Where(Function(p) Directory.Exists(p)).First.ToUpper.First & ":\" '#3799
''' <summary>
''' 程序的缓存文件夹路径,以 \ 结尾。
''' </summary>
@@ -1257,12 +1257,19 @@ Re:
Dim DeletedCount As Integer = 0
Dim Temp As String()
Temp = Directory.GetFiles(Path)
For Each str As String In Temp
For Each FilePath As String In Temp
Dim RetriedFile As Boolean = False
RetryFile:
Try
File.Delete(str)
File.Delete(FilePath)
DeletedCount += 1
Catch ex As Exception
If IgnoreIssue Then
If Not RetriedFile Then
RetriedFile = True
Log(ex, $"删除文件失败,将在 0.3s 后重试({FilePath})")
Thread.Sleep(300)
GoTo RetryFile
ElseIf IgnoreIssue Then
Log(ex, "删除单个文件可忽略地失败")
Else
Throw
@@ -1273,10 +1280,17 @@ Re:
For Each str As String In Temp
DeleteDirectory(str, IgnoreIssue)
Next
Dim RetriedDir As Boolean = False
RetryDir:
Try
Directory.Delete(Path, True)
Catch ex As Exception
If IgnoreIssue Then
If Not RetriedDir Then
RetriedDir = True
Log(ex, $"删除文件夹失败,将在 0.3s 后重试({Path})")
Thread.Sleep(300)
GoTo RetryDir
ElseIf IgnoreIssue Then
Log(ex, "删除单个文件夹可忽略地失败")
Else
Throw
@@ -1652,7 +1666,10 @@ Re:
''' 为字符串进行 XML 转义。
''' </summary>
Public Function EscapeXML(Str As String) As String
Return Str.Replace("&", "&amp;").Replace("<", "&lt;").Replace(">", "&gt;").Replace("'", "&apos;").Replace("""", "&quot;").Replace(vbCrLf, "&#xa;")
If Str.StartsWithF("{") Then Str = "{}" & Str '#4187
Return Str.
Replace("&", "&amp;").Replace("<", "&lt;").Replace(">", "&gt;").Replace("'", "&apos;").
Replace("""", "&quot;").Replace(vbCrLf, "&#xa;")
End Function
'正则
@@ -2065,15 +2082,16 @@ NextElement:
''' 在新的工作线程中执行代码。
''' </summary>
Public Function RunInNewThread(Action As Action, Name As String, Optional Priority As ThreadPriority = ThreadPriority.Normal) As Thread
Dim th As New Thread(Sub()
Try
Action()
Catch ex As ThreadInterruptedException
Log(Name & ":线程已中止")
Catch ex As Exception
Log(ex, Name & ":线程执行失败", LogLevel.Feedback)
End Try
End Sub) With {.Name = Name, .Priority = Priority}
Dim th As New Thread(
Sub()
Try
Action()
Catch ex As ThreadInterruptedException
Log(Name & ":线程已中止")
Catch ex As Exception
Log(ex, Name & ":线程执行失败", LogLevel.Feedback)
End Try
End Sub) With {.Name = Name, .Priority = Priority}
th.Start()
Return th
End Function
@@ -2186,7 +2204,9 @@ NextElement:
''' </summary>
Public Sub OpenWebsite(Url As String)
Try
If Not Url.StartsWithF("http", True) Then Throw New Exception(Url & " 不是一个有效的网址,它必须以 http 开头!")
If Not Url.StartsWithF("http", True) AndAlso Not Url.StartsWithF("minecraft://", True) Then
Throw New Exception(Url & " 不是一个有效的网址,它必须以 http 开头!")
End If
Log("[System] 正在打开网页:" & Url)
Process.Start(Url)
Catch ex As Exception
@@ -2211,25 +2231,27 @@ NextElement:
''' 设置剪贴板。将在另一线程运行,且不会抛出异常。
''' </summary>
Public Sub ClipboardSet(Text As String, Optional ShowSuccessHint As Boolean = True)
RunInThread(Sub()
Dim RetryCount As Integer = 0
RunInThread(
Sub()
Dim RetryCount As Integer = 0
Retry:
Try
RunInUi(Sub()
My.Computer.Clipboard.Clear()
My.Computer.Clipboard.SetText(Text)
End Sub)
Catch ex As Exception
RetryCount += 1
If RetryCount <= 5 Then
Thread.Sleep(20)
GoTo Retry
Else
Log(ex, "可能由于剪贴板被其他程序占用,文本复制失败", LogLevel.Hint)
End If
End Try
If ShowSuccessHint Then Hint("已成功复制!", HintType.Finish)
End Sub)
Try
RunInUi(
Sub()
My.Computer.Clipboard.Clear()
My.Computer.Clipboard.SetText(Text)
End Sub)
Catch ex As Exception
RetryCount += 1
If RetryCount <= 5 Then
Thread.Sleep(20)
GoTo Retry
Else
Log(ex, "可能由于剪贴板被其他程序占用,文本复制失败", LogLevel.Hint)
End If
End Try
If ShowSuccessHint Then Hint("已成功复制!", HintType.Finish)
End Sub)
End Sub
''' <summary>
@@ -2448,39 +2470,40 @@ Retry:
Private LogList As New StringBuilder
Private LogWritter As StreamWriter
Public Sub LogStart()
RunInNewThread(Sub()
Dim IsInitSuccess As Boolean = True
Try
For i = 4 To 1 Step -1
If File.Exists(Path & "PCL\Log" & i & ".txt") Then
If File.Exists(Path & "PCL\Log" & (i + 1) & ".txt") Then File.Delete(Path & "PCL\Log" & (i + 1) & ".txt")
CopyFile(Path & "PCL\Log" & i & ".txt", Path & "PCL\Log" & (i + 1) & ".txt")
End If
Next
File.Create(Path & "PCL\Log1.txt").Dispose()
Catch ex As IOException
IsInitSuccess = False
Hint("可能同时开启了多个 PCL,程序可能会出现未知问题!", HintType.Critical)
Log(ex, "日志初始化失败(疑似文件占用问题)")
Catch ex As Exception
IsInitSuccess = False
Log(ex, "日志初始化失败", LogLevel.Hint)
End Try
Try
LogWritter = New StreamWriter(Path & "PCL\Log1.txt", True) With {.AutoFlush = True}
Catch ex As Exception
LogWritter = Nothing
Log(ex, "日志写入失败", LogLevel.Hint)
End Try
While True
If IsInitSuccess Then
LogFlush()
Else
LogList = New StringBuilder '清空 LogList 避免内存爆炸
End If
Thread.Sleep(50)
End While
End Sub, "Log Writer", ThreadPriority.Lowest)
RunInNewThread(
Sub()
Dim IsInitSuccess As Boolean = True
Try
For i = 4 To 1 Step -1
If File.Exists(Path & "PCL\Log" & i & ".txt") Then
If File.Exists(Path & "PCL\Log" & (i + 1) & ".txt") Then File.Delete(Path & "PCL\Log" & (i + 1) & ".txt")
CopyFile(Path & "PCL\Log" & i & ".txt", Path & "PCL\Log" & (i + 1) & ".txt")
End If
Next
File.Create(Path & "PCL\Log1.txt").Dispose()
Catch ex As IOException
IsInitSuccess = False
Hint("可能同时开启了多个 PCL,程序可能会出现未知问题!", HintType.Critical)
Log(ex, "日志初始化失败(疑似文件占用问题)")
Catch ex As Exception
IsInitSuccess = False
Log(ex, "日志初始化失败", LogLevel.Hint)
End Try
Try
LogWritter = New StreamWriter(Path & "PCL\Log1.txt", True) With {.AutoFlush = True}
Catch ex As Exception
LogWritter = Nothing
Log(ex, "日志写入失败", LogLevel.Hint)
End Try
While True
If IsInitSuccess Then
LogFlush()
Else
LogList = New StringBuilder '清空 LogList 避免内存爆炸
End If
Thread.Sleep(50)
End While
End Sub, "Log Writer", ThreadPriority.Lowest)
End Sub
Private ReadOnly LogFlushLock As New Object '防止外部调用 LogFlush 时同时输出多次日志
Public Sub LogFlush()
+11 -15
View File
@@ -341,14 +341,15 @@ Retry:
Dim RequestEx As Exception = Nothing
Dim FailCount As Integer = 0
For i = 1 To RequestCount
Dim th As New Thread(Sub()
Try
RequestResult = NetRequestOnce(Url, Method, Data, ContentType, 30000, Headers)
Catch ex As Exception
FailCount += 1
RequestEx = ex
End Try
End Sub)
Dim th As New Thread(
Sub()
Try
RequestResult = NetRequestOnce(Url, Method, Data, ContentType, 30000, Headers)
Catch ex As Exception
FailCount += 1
RequestEx = ex
End Try
End Sub)
th.Start()
Threads.Add(th)
Thread.Sleep(i * 250)
@@ -382,7 +383,7 @@ RequestFinished:
Dim Resp As WebResponse = Nothing
Dim Req As HttpWebRequest
Try
Req = WebRequest.Create(New Uri(Url))
Req = WebRequest.Create(Url)
Req.Method = Method
Dim SendData As Byte()
If TypeOf Data Is Byte() Then
@@ -1859,15 +1860,10 @@ Retry:
Try
While True
Thread.Sleep(20)
'若已完成,则清空
If Id = 0 AndAlso FileRemain = 0 AndAlso Files.Any() Then
SyncLock LockFiles
Files.Clear()
End SyncLock
End If
'获取文件列表
Dim AllFiles As List(Of NetFile)
SyncLock LockFiles
If Id = 0 AndAlso FileRemain = 0 AndAlso Files.Any() Then Files.Clear() '若已完成,则清空
AllFiles = Files.Values.ToList()
End SyncLock
Dim WaitingFiles As New List(Of NetFile)
@@ -372,12 +372,12 @@
ModLoaders = New List(Of CompModLoaderType)
For Each Category In Data("categories").Select(Function(t) t.ToString)
Select Case Category
'加载器
'加载器
Case "forge" : ModLoaders.Add(CompModLoaderType.Forge)
Case "fabric" : ModLoaders.Add(CompModLoaderType.Fabric)
Case "quilt" : ModLoaders.Add(CompModLoaderType.Quilt)
Case "neoforge" : ModLoaders.Add(CompModLoaderType.NeoForge)
'Mod
'Mod
Case "worldgen" : Tags.Add("世界元素")
Case "technology" : Tags.Add("科技")
Case "food" : Tags.Add("食物/烹饪")
@@ -393,7 +393,7 @@
Case "social" : Tags.Add("服务器")
Case "utility" : Tags.Add("改良")
Case "library" : Tags.Add("支持库")
'整合包
'整合包
Case "multiplayer" : Tags.Add("多人")
Case "optimization" : Tags.Add("性能优化")
Case "challenging" : Tags.Add("硬核")
@@ -404,7 +404,7 @@
Case "adventure" : Tags.Add("冒险")
Case "kitchen-sink" : Tags.Add("烹饪")
Case "lightweight" : Tags.Add("轻量")
'资源包
'资源包
Case "8x-" : Tags.Add("8x-")
Case "16x" : Tags.Add("16x")
Case "32x" : Tags.Add("32x")
@@ -676,19 +676,19 @@ NoSubtitle:
If Id = Project.Id Then Return True '相同实例
'提取字符串中的字母和数字
Dim GetRaw =
Function(Data As String) As String
Dim Result As New StringBuilder()
For Each r As Char In Data.Where(Function(c) Char.IsLetterOrDigit(c))
Result.Append(r)
Next
Return Result.ToString.ToLower
End Function
Function(Data As String) As String
Dim Result As New StringBuilder()
For Each r As Char In Data.Where(Function(c) Char.IsLetterOrDigit(c))
Result.Append(r)
Next
Return Result.ToString.ToLower
End Function
'来自不同的网站
If FromCurseForge = Project.FromCurseForge Then Return False
'Mod 加载器一致
If ModLoaders.Count <> Project.ModLoaders.Count OrElse ModLoaders.Except(Project.ModLoaders).Count > 0 Then Return False
If ModLoaders.Count <> Project.ModLoaders.Count OrElse ModLoaders.Except(Project.ModLoaders).Any() Then Return False
'MC 版本一致
If GameVersions.Count <> Project.GameVersions.Count OrElse GameVersions.Except(Project.GameVersions).Count > 0 Then Return False
If GameVersions.Count <> Project.GameVersions.Count OrElse GameVersions.Except(Project.GameVersions).Any() Then Return False
'MCMOD 翻译名 / 原名 / 描述文本 / Slug 的英文部分相同
If TranslatedName = Project.TranslatedName OrElse
RawName = Project.RawName OrElse Description = Project.Description OrElse
@@ -1367,6 +1367,7 @@ Retry:
Dim RawLoaders As List(Of String) = Data("loaders").Select(Function(v) v.ToString).ToList
ModLoaders = New List(Of CompModLoaderType)
If RawLoaders.Contains("forge") Then ModLoaders.Add(CompModLoaderType.Forge)
If RawLoaders.Contains("neoforge") Then ModLoaders.Add(CompModLoaderType.NeoForge)
If RawLoaders.Contains("fabric") Then ModLoaders.Add(CompModLoaderType.Fabric)
If RawLoaders.Contains("quilt") Then ModLoaders.Add(CompModLoaderType.Quilt)
#End Region
@@ -697,8 +697,8 @@ NextStack:
"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",
"preinit", "preload", "machine", "reflect", "channel", "general", "handler", "content", "systems", "modules", "service",
"fastutil", "optifine", "internal", "platform", "override", "fabricmc",
"injection", "listeners", "scheduler", "minecraft", "transformer", "transformers", "universal", "multipart", "minecraftforge", "blockentity", "spongepowered", "electronwill"
"fastutil", "optifine", "internal", "platform", "override", "fabricmc", "neoforge",
"injection", "listeners", "scheduler", "minecraft", "transformer", "transformers", "neoforged", "universal", "multipart", "minecraftforge", "blockentity", "spongepowered", "electronwill"
}.Contains(Word.ToLower) Then Continue For
PossibleWords.Add(Word.Trim)
Next
@@ -8,9 +8,13 @@
''' </summary>
Public Function DlClientJarGet(Version As McVersion, ReturnNothingOnFileUseable As Boolean) As NetFile
'获取底层继承版本
Do While Not String.IsNullOrEmpty(Version.InheritVersion)
Version = New McVersion(Version.InheritVersion)
Loop
Try
Do While Not String.IsNullOrEmpty(Version.InheritVersion)
Version = New McVersion(Version.InheritVersion)
Loop
Catch ex As Exception
Log(ex, "获取底层继承版本失败")
End Try
'检查 Json 是否标准
If Version.JsonObject("downloads") Is Nothing OrElse Version.JsonObject("downloads")("client") Is Nothing OrElse Version.JsonObject("downloads")("client")("url") Is Nothing Then
Throw New Exception("底层版本 " & Version.Name & " 中无 jar 文件下载信息")
@@ -220,7 +224,7 @@
End If
Setup.Set("ToolUpdateSnapshotLast", If(Version, "Nothing"))
Catch ex As Exception
Throw New Exception("版本列表解析失败", ex)
Throw New Exception("Minecraft 官方源版本列表解析失败", ex)
End Try
End Sub
''' <summary>
@@ -237,7 +241,7 @@
'返回
Loader.Output = New DlClientListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Json}
Catch ex As Exception
Throw New Exception("版本列表解析失败(" & Json.ToString & ")", ex)
Throw New Exception("Minecraft BMCLAPI 版本列表解析失败(" & Json.ToString & ")", ex)
End Try
End Sub
@@ -288,6 +292,7 @@
''' </summary>
Public Value As List(Of DlOptiFineListEntry)
End Structure
Public Class DlOptiFineListEntry
''' <summary>
''' 显示名称,已去除 HD_U 字样,如“1.12.2 C8”。
@@ -359,29 +364,33 @@
Private Sub DlOptiFineListOfficialMain(Loader As LoaderTask(Of Integer, DlOptiFineListResult))
Dim Result As String = NetGetCodeByClient("https://optifine.net/downloads", Encoding.Default)
If Result.Length < 200 Then Throw New Exception("获取到的版本列表长度不足(" & Result & ")")
'获取所有版本信息
Dim Forge As List(Of String) = RegexSearch(Result, "(?<=colForge'>)[^<]*")
Dim ReleaseTime As List(Of String) = RegexSearch(Result, "(?<=colDate'>)[^<]+")
Dim Name As List(Of String) = RegexSearch(Result, "(?<=OptiFine_)[0-9A-Za-z_.]+(?=.jar"")")
If Not ReleaseTime.Count = Name.Count Then Throw New Exception("版本与发布时间数据无法对应")
If Not Forge.Count = Name.Count Then Throw New Exception("版本与 Forge 兼容数据无法对应")
If ReleaseTime.Count < 10 Then Throw New Exception("获取到的版本数量不足(" & Result & ")")
'转化为列表输出
Dim Versions As New List(Of DlOptiFineListEntry)
For i = 0 To ReleaseTime.Count - 1
Name(i) = Name(i).Replace("_", " ")
Dim Entry As New DlOptiFineListEntry With {
.NameDisplay = Name(i).Replace("HD U ", "").Replace(".0 ", " "),
.ReleaseTime = Join({ReleaseTime(i).Split(".")(2), ReleaseTime(i).Split(".")(1), ReleaseTime(i).Split(".")(0)}, "/"),
.IsPreview = Name(i).ContainsF("pre", True),
.Inherit = Name(i).ToString.Split(" ")(0),
.NameFile = If(Name(i).ContainsF("pre", True), "preview_", "") & "OptiFine_" & Name(i).Replace(" ", "_") & ".jar",
.RequiredForgeVersion = Forge(i).Replace("Forge ", "").Replace("#", "")}
If Entry.RequiredForgeVersion.Contains("N/A") Then Entry.RequiredForgeVersion = Nothing
Entry.NameVersion = Entry.Inherit & "-OptiFine_" & Name(i).ToString.Replace(" ", "_").Replace(Entry.Inherit & "_", "")
Versions.Add(Entry)
Next
Loader.Output = New DlOptiFineListResult With {.IsOfficial = True, .SourceName = "OptiFine 官方源", .Value = Versions}
Try
'获取所有版本信息
Dim Forge As List(Of String) = RegexSearch(Result, "(?<=colForge'>)[^<]*")
Dim ReleaseTime As List(Of String) = RegexSearch(Result, "(?<=colDate'>)[^<]+")
Dim Name As List(Of String) = RegexSearch(Result, "(?<=OptiFine_)[0-9A-Za-z_.]+(?=.jar"")")
If Not ReleaseTime.Count = Name.Count Then Throw New Exception("版本与发布时间数据无法对应")
If Not Forge.Count = Name.Count Then Throw New Exception("版本与 Forge 兼容数据无法对应")
If ReleaseTime.Count < 10 Then Throw New Exception("获取到的版本数量不足(" & Result & ")")
'转化为列表输出
Dim Versions As New List(Of DlOptiFineListEntry)
For i = 0 To ReleaseTime.Count - 1
Name(i) = Name(i).Replace("_", " ")
Dim Entry As New DlOptiFineListEntry With {
.NameDisplay = Name(i).Replace("HD U ", "").Replace(".0 ", " "),
.ReleaseTime = Join({ReleaseTime(i).Split(".")(2), ReleaseTime(i).Split(".")(1), ReleaseTime(i).Split(".")(0)}, "/"),
.IsPreview = Name(i).ContainsF("pre", True),
.Inherit = Name(i).ToString.Split(" ")(0),
.NameFile = If(Name(i).ContainsF("pre", True), "preview_", "") & "OptiFine_" & Name(i).Replace(" ", "_") & ".jar",
.RequiredForgeVersion = Forge(i).Replace("Forge ", "").Replace("#", "")}
If Entry.RequiredForgeVersion.Contains("N/A") Then Entry.RequiredForgeVersion = Nothing
Entry.NameVersion = Entry.Inherit & "-OptiFine_" & Name(i).ToString.Replace(" ", "_").Replace(Entry.Inherit & "_", "")
Versions.Add(Entry)
Next
Loader.Output = New DlOptiFineListResult With {.IsOfficial = True, .SourceName = "OptiFine 官方源", .Value = Versions}
Catch ex As Exception
Throw New Exception("OptiFine 官方源版本列表解析失败(" & Result & ")", ex)
End Try
End Sub
''' <summary>
@@ -407,7 +416,7 @@
Next
Loader.Output = New DlOptiFineListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Versions}
Catch ex As Exception
Throw New Exception("版本列表解析失败(" & Json.ToString & ")", ex)
Throw New Exception("OptiFine BMCLAPI 版本列表解析失败(" & Json.ToString & ")", ex)
End Try
End Sub
@@ -485,15 +494,61 @@
#Region "DlForgeVersion | Forge 版本列表"
Public Class DlForgeVersionEntry
Public MustInherit Class DlForgelikeEntry
Public IsNeoForge As Boolean
''' <summary>
''' 完整的版本名,如 “14.22.1.2478”。
''' 加载器名称。Forge 或 NeoForge。
''' </summary>
Public Version As String
Public ReadOnly Property LoaderName As String
Get
Return If(IsNeoForge, "NeoForge", "Forge")
End Get
End Property
''' <summary>
''' 文件扩展名。不以小数点开头。
''' </summary>
Public ReadOnly Property FileExtension As String
Get
If IsNeoForge Then
Return "jar"
Else
Return If(CType(Me, DlForgeVersionEntry).Category = "installer", "jar", "zip")
End If
End Get
End Property
''' <summary>
''' Forge:MC 版本是否小于 1.13。
''' NeoForge:MC 版本是否为 1.20.1。
''' </summary>
Public ReadOnly Property IsLegacy As Boolean
Get
'虽然很抽象,但确实可以这样判断
'Forge:1.13+ 的版本号首位都大于 20
'NeoForge:1.20.1 的版本号首位人为规定为 19 开头
Return Version.Major < 20
End Get
End Property
''' <summary>
''' 标准化后的版本号,仅可用于比较与排序。
''' 格式:Major.Minor.Build.Revision
''' Forge:如 “50.1.9.0”(最后一位固定为 0)、“14.22.1.2478”(Legacy)。
''' NeoForge:如 “20.4.30.0”(最后一位固定为 0)、“19.47.1.99”(Legacy:第一位固定为 19)。
''' </summary>
Public Version As Version
''' <summary>
''' 可对玩家显示的非格式化版本名。
''' Forge:如 “50.1.9”、“14.22.1.2478”(Legacy)。
''' NeoForge:如 “20.4.30-beta”、“47.1.99”(Legacy)。
''' </summary>
Public VersionName As String
''' <summary>
''' 对应的 Minecraft 版本,如“1.12.2”。
''' </summary>
Public Inherit As String
End Class
Public Class DlForgeVersionEntry
Inherits DlForgelikeEntry
''' <summary>
''' 发布时间,格式为“yyyy/MM/dd HH:mm”。
''' </summary>
@@ -511,58 +566,21 @@
''' </summary>
Public Category As String
''' <summary>
''' 版本分支。若无分支则为 Nothing。
''' </summary>
Public Branch As String = Nothing
''' <summary>
''' 是否为新版 Forge。(即为 Minecraft 1.13+)
''' </summary>
Public ReadOnly Property IsNewType As Boolean
Get
Return Version.Split(".")(0) >= 20
End Get
End Property
''' <summary>
''' 构建数。
''' </summary>
Public ReadOnly Property Build As Integer
Get
Dim Version = Me.Version.Split(".")
If Version(0) < 15 Then
Return Version(Version.Count - 1)
Else
Return Version(Version.Count - 1) + 10000
End If
End Get
End Property
''' <summary>
''' 用于下载的文件版本名。可能在 Version 的基础上添加了分支。
''' </summary>
Public ReadOnly Property FileVersion As String
Get
Return Version & If(Branch Is Nothing, "", "-" & Branch)
End Get
End Property
''' <summary>
''' 即将下载的文件全名。
''' </summary>
Public ReadOnly Property FileName As String
Get
Return "forge-" & Inherit & "-" & FileVersion & "-" & Category & "." & FileSuffix
End Get
End Property
''' <summary>
''' 文件扩展名。
''' </summary>
Public ReadOnly Property FileSuffix As String
Get
If Category = "installer" Then
Return "jar"
Else
Return "zip"
End If
End Get
End Property
Public FileVersion As String
Public Sub New(Version As String, Branch As String, Inherit As String)
'司马版本的特殊处理
If Version = "11.15.1.2318" OrElse Version = "11.15.1.1902" OrElse Version = "11.15.1.1890" Then Branch = "1.8.9"
If Branch Is Nothing AndAlso Inherit = "1.7.10" AndAlso Version.Split(".")(3) >= 1300 Then Branch = "1.7.10"
'为 DlForgelikeEntry 提供所有信息
IsNeoForge = False
VersionName = Version
Me.Version = New Version(Version)
Me.Inherit = Inherit
FileVersion = Version & If(Branch Is Nothing, "", "-" & Branch)
End Sub
End Class
''' <summary>
@@ -596,7 +614,9 @@
Public Sub DlForgeVersionOfficialMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
Dim Result As String
Try
Result = NetGetCodeByDownload("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" & Loader.Input & ".html", UseBrowserUserAgent:=True)
Result = NetGetCodeByDownload("https://files.minecraftforge.net/maven/net/minecraftforge/forge/index_" &
Loader.Input.Replace("-", "_") & '兼容 Forge 1.7.10-pre4,#4057
".html", UseBrowserUserAgent:=True)
Catch ex As Exception
If GetExceptionSummary(ex).Contains("(404)") Then
Throw New Exception("没有可用版本")
@@ -620,8 +640,6 @@
'分支获取
Dim Branch As String = RegexSeek(VersionCode, $"(?<=-{Name}-)[^-""]+(?=-[a-z]+.[a-z]{{3}})")
If String.IsNullOrWhiteSpace(Branch) Then Branch = Nothing
If Name = "11.15.1.2318" OrElse Name = "11.15.1.1902" OrElse Name = "11.15.1.1890" Then Branch = "1.8.9"
If Branch Is Nothing AndAlso Inherit = "1.7.10" AndAlso Name.Split(".")(3) >= 1300 Then Branch = "1.7.10"
'发布时间获取
Dim ReleaseTimeOriginal = RegexSeek(VersionCode, "(?<=""download-time"" title="")[^""]+")
Dim ReleaseTimeSplit = ReleaseTimeOriginal.Split(" -:".ToCharArray) '原格式:"2021-02-15 03:24:02"
@@ -651,13 +669,13 @@
Continue For
End If
'添加进列表
Versions.Add(New DlForgeVersionEntry With {.Category = Category, .Version = Name, .IsRecommended = IsRecommended, .Hash = MD5.Trim(vbCr, vbLf), .Inherit = Inherit, .ReleaseTime = ReleaseTime, .Branch = Branch})
Versions.Add(New DlForgeVersionEntry(Name, Branch, Inherit) With {.Category = Category, .IsRecommended = IsRecommended, .Hash = MD5.Trim(vbCr, vbLf), .ReleaseTime = ReleaseTime})
Catch ex As Exception
Throw New Exception("版本信息提取失败(" & VersionCode & ")", ex)
Throw New Exception("Forge 官方源版本信息提取失败(" & VersionCode & ")", ex)
End Try
Next
Catch ex As Exception
Throw New Exception("版本列表解析失败(" & Result & ")", ex)
Throw New Exception("Forge 官方源版本列表解析失败(" & Result & ")", ex)
End Try
If Not Versions.Any() Then Throw New Exception("没有可用版本")
Loader.Output = Versions
@@ -667,7 +685,9 @@
''' Forge 版本列表,BMCLAPI。
''' </summary>
Public Sub DlForgeVersionBmclapiMain(Loader As LoaderTask(Of String, List(Of DlForgeVersionEntry)))
Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" & Loader.Input, IsJson:=True)
Dim Json As JArray = NetGetCodeByRequestRetry("https://bmclapi2.bangbang93.com/forge/minecraft/" &
Loader.Input.Replace("-", "_"), '兼容 Forge 1.7.10-pre4,#4057
IsJson:=True)
Dim Versions As New List(Of DlForgeVersionEntry)
Try
Dim Recommended As String = McDownloadForgeRecommendedGet(Loader.Input)
@@ -700,20 +720,17 @@
End Select
Next
'获取 Entry
Dim Inherit As String = Loader.Input
Dim Branch As String = Token("branch")
Dim Name As String = Token("version")
If Name = "11.15.1.2318" OrElse Name = "11.15.1.1902" OrElse Name = "11.15.1.1890" Then Branch = "1.8.9"
If Branch Is Nothing AndAlso Inherit = "1.7.10" AndAlso Name.Split(".")(3) >= 1300 Then Branch = "1.7.10"
'基础信息获取
Dim Entry = New DlForgeVersionEntry With {.Hash = Hash, .Category = Category, .Version = Name, .Branch = Branch, .Inherit = Inherit, .IsRecommended = Recommended = Name}
Dim Entry = New DlForgeVersionEntry(Name, Branch, Loader.Input) With {.Hash = Hash, .Category = Category, .IsRecommended = Recommended = Name}
Dim TimeSplit = Token("modified").ToString.Split("-"c, "T"c, ":"c, "."c, " "c, "/"c)
Entry.ReleaseTime = Token("modified").ToObject(Of Date).ToLocalTime.ToString("yyyy'/'MM'/'dd HH':'mm")
'添加项
Versions.Add(Entry)
Next
Catch ex As Exception
Throw New Exception("版本列表解析失败(" & Json.ToString & ")", ex)
Throw New Exception("Forge BMCLAPI 版本列表解析失败(" & Json.ToString & ")", ex)
End Try
If Not Versions.Any() Then Throw New Exception("没有可用版本")
Loader.Output = Versions
@@ -721,6 +738,132 @@
#End Region
#Region "DlNeoForgeList | NeoForge 版本列表"
Public Structure DlNeoForgeListResult
''' <summary>
''' 数据来源名称,如“Official”,“BMCLAPI”。
''' </summary>
Public SourceName As String
''' <summary>
''' 是否为官方的实时数据。
''' </summary>
Public IsOfficial As Boolean
''' <summary>
''' 所有版本的列表。已经按从新到老排序。
''' </summary>
Public Value As List(Of DlNeoForgeListEntry)
End Structure
Public Class DlNeoForgeListEntry
Inherits DlForgelikeEntry
''' <summary>
''' 是否是 Beta 版。
''' </summary>
Public IsBeta As Boolean
''' <summary>
''' API 使用的原始版本字符串,如 “20.4.30-beta”、“1.20.1-47.1.99”(Legacy)。
''' </summary>
Public ApiName As String
''' <summary>
''' 文件在官网的基础地址,不包含后缀。
''' </summary>
Public ReadOnly Property UrlBase As String
Get
Dim PackageName As String = If(IsLegacy, "forge", "neoforge")
Return $"https://maven.neoforged.net/releases/net/neoforged/{PackageName}/{ApiName}/{PackageName}-{ApiName}"
End Get
End Property
Public Sub New(ApiName As String)
IsNeoForge = True
Me.ApiName = ApiName
IsBeta = ApiName.Contains("beta")
If ApiName.Contains("1.20.1") Then '1.20.1-47.1.99
VersionName = ApiName.Replace("1.20.1-", "")
Version = New Version("19." & VersionName)
Inherit = "1.20.1"
Else '20.4.30-beta
VersionName = ApiName
Version = New Version(ApiName.Before("-"))
Inherit = $"1.{Version.Major}" & If(Version.Minor = 0, "", "." & Version.Minor)
End If
End Sub
End Class
''' <summary>
''' NeoForge 版本列表,主加载器。
''' </summary>
Public DlNeoForgeListLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Main", AddressOf DlNeoForgeListMain)
Private Sub DlNeoForgeListMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
Select Case Setup.Get("ToolDownloadVersion")
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)
}, 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)
}, 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)
}, Loader.IsForceRestarting)
End Select
End Sub
''' <summary>
''' NeoForge 版本列表,官方源。
''' </summary>
Public DlNeoForgeListOfficialLoader As New LoaderTask(Of Integer, DlNeoForgeListResult)("DlNeoForgeList Official", AddressOf DlNeoForgeListOfficialMain)
Private Sub DlNeoForgeListOfficialMain(Loader As LoaderTask(Of Integer, DlNeoForgeListResult))
'获取版本列表 JSON
Dim ResultLatest As String = NetGetCodeByDownload("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/neoforge", UseBrowserUserAgent:=True, IsJson:=True)
Dim ResultLegacy As String = NetGetCodeByDownload("https://maven.neoforged.net/api/maven/versions/releases/net/neoforged/forge", UseBrowserUserAgent:=True, IsJson:=True)
If ResultLatest.Length < 100 OrElse ResultLegacy.Length < 100 Then Throw New Exception("获取到的版本列表长度不足(" & ResultLatest & ")")
'解析
Try
Loader.Output = New DlNeoForgeListResult With {.IsOfficial = True, .SourceName = "NeoForge 官方源",
.Value = GetNeoForgeEntries(ResultLatest, ResultLegacy)}
Catch ex As Exception
Throw New Exception("NeoForge 官方源版本列表解析失败(" & ResultLatest & vbCrLf & vbCrLf & ResultLegacy & ")", ex)
End Try
End Sub
''' <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))
'获取版本列表 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)
If ResultLatest.Length < 100 OrElse ResultLegacy.Length < 100 Then Throw New Exception("获取到的版本列表长度不足(" & ResultLatest & ")")
'解析
Try
Loader.Output = New DlNeoForgeListResult With {.IsOfficial = True, .SourceName = "BMCLAPI",
.Value = GetNeoForgeEntries(ResultLatest, ResultLegacy)}
Catch ex As Exception
Throw New Exception("NeoForge BMCLAPI 版本列表解析失败(" & ResultLatest & vbCrLf & vbCrLf & ResultLegacy & ")", ex)
End Try
End Sub
Private Function GetNeoForgeEntries(LatestJson As String, LatestLegacyJson As String) As List(Of DlNeoForgeListEntry)
Dim VersionNames = RegexSearch(LatestLegacyJson & LatestJson,
"(?<="")(1\.20\.1-)?\d+\.\d+\.\d+(-beta)?(?="")") '我寻思直接正则就行.jpg
Dim Versions = VersionNames.
Where(Function(name) name <> "47.1.82"). '这个版本虽然在版本列表中,但不能下载
Select(Function(name) New DlNeoForgeListEntry(name)).ToList
If Not Versions.Any() Then Throw New Exception("没有可用版本")
Versions = Versions.OrderByDescending(Function(a) a.Version).ToList
Return Versions
End Function
#End Region
#Region "DlLiteLoaderList | LiteLoader 版本列表"
Public Structure DlLiteLoaderListResult
@@ -741,6 +884,7 @@
''' </summary>
Public OfficialError As Exception
End Structure
Public Class DlLiteLoaderListEntry
''' <summary>
''' 实际的文件名,如“liteloader-installer-1.12-00-SNAPSHOT.jar”。
@@ -820,7 +964,7 @@
Next
Loader.Output = New DlLiteLoaderListResult With {.IsOfficial = True, .SourceName = "LiteLoader 官方源", .Value = Versions}
Catch ex As Exception
Throw New Exception("版本列表解析失败(" & Result.ToString & ")", ex)
Throw New Exception("LiteLoader 官方源版本列表解析失败(" & Result.ToString & ")", ex)
End Try
End Sub
@@ -848,7 +992,7 @@
Next
Loader.Output = New DlLiteLoaderListResult With {.IsOfficial = False, .SourceName = "BMCLAPI", .Value = Versions}
Catch ex As Exception
Throw New Exception("版本列表解析失败(" & Result.ToString & ")", ex)
Throw New Exception("LiteLoader BMCLAPI 版本列表解析失败(" & Result.ToString & ")", ex)
End Try
End Sub
@@ -906,7 +1050,7 @@
If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项")
Loader.Output = Output
Catch ex As Exception
Throw New Exception("列表解析失败(" & Result.ToString & ")", ex)
Throw New Exception("Fabric 官方源版本列表解析失败(" & Result.ToString & ")", ex)
End Try
End Sub
@@ -921,7 +1065,7 @@
If Output.Value("game") Is Nothing OrElse Output.Value("loader") Is Nothing OrElse Output.Value("installer") Is Nothing Then Throw New Exception("获取到的列表缺乏必要项")
Loader.Output = Output
Catch ex As Exception
Throw New Exception("列表解析失败(" & Result.ToString & ")", ex)
Throw New Exception("Fabric BMCLAPI 版本列表解析失败(" & Result.ToString & ")", ex)
End Try
End Sub
@@ -944,25 +1088,25 @@
Public Function DlSourceResourceGet(MojangBase As String) As String()
MojangBase = MojangBase.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
}
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
}
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
}
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
}
End Function
Public Function DlSourceLauncherOrMetaGet(MojangBase As String) As String()
If MojangBase 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
}
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
}
End Function
Private Sub DlSourceLoader(Of InputType, OutputType)(MainLoader As LoaderTask(Of InputType, OutputType),
@@ -240,21 +240,25 @@
Dim UserJava As JavaEntry = Nothing
'获取版本独立设置中指定的 Java
If RelatedVersion IsNot Nothing AndAlso Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion).ToString.StartsWithF("{") Then
Try
UserJava = JavaEntry.FromJson(GetJson(Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion)))
UserJava.Check()
Catch ex As ThreadInterruptedException
Throw
Catch ex As Exception
UserJava = Nothing
Setup.Reset("VersionArgumentJavaSelect", Version:=RelatedVersion)
Log(ex, "版本独立设置中指定的 Java 已无法使用,此设置已重置", LogLevel.Hint)
End Try
Dim VersionSelect As String = ""
If RelatedVersion IsNot Nothing Then
VersionSelect = Setup.Get("VersionArgumentJavaSelect", Version:=RelatedVersion)
If VersionSelect.StartsWithF("{") Then
Try
UserJava = JavaEntry.FromJson(GetJson(VersionSelect))
UserJava.Check()
Catch ex As ThreadInterruptedException
Throw
Catch ex As Exception
UserJava = Nothing
Setup.Reset("VersionArgumentJavaSelect", Version:=RelatedVersion)
Log(ex, "版本独立设置中指定的 Java 已无法使用,此设置已重置", LogLevel.Hint)
End Try
End If
End If
'获取全局设置中指定的 Java
If UserJava Is Nothing AndAlso Setup.Get("LaunchArgumentJavaSelect") <> "" Then
If UserJava Is Nothing AndAlso VersionSelect <> "" AndAlso Setup.Get("LaunchArgumentJavaSelect") <> "" Then
Try
UserJava = JavaEntry.FromJson(GetJson(Setup.Get("LaunchArgumentJavaSelect")))
UserJava.Check()
@@ -665,34 +669,18 @@ Wait:
'若该目录有 Java,则加入结果
If File.Exists(Path & "javaw.exe") Then Results(Path) = Source
'查找其下的所有文件夹
Dim Keywords = {"java", "jdk", "env", "环境", "run", "软件", "jre", "mc", "dragon",
"soft", "cache", "temp", "corretto", "roaming", "users", "craft", "program", "世界", "net",
"游戏", "oracle", "game", "file", "data", "jvm", "服务", "server", "客户", "client", "整合",
"应用", "运行", "前置", "mojang", "官启", "新建文件夹", "eclipse", "microsoft", "hotspot",
"runtime", "x86", "x64", "forge", "原版", "optifine", "官方", "启动", "hmcl", "mod", "高清",
"download", "launch", "程序", "path", "version", "baka", "pcl", "zulu", "local", "packages",
"4297127d64ec6", "国服", "网易", "ext", "netease", "1.", "启动"}
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
SearchEntry.Contains("java") OrElse SearchEntry.Contains("jdk") OrElse SearchEntry.Contains("env") OrElse
SearchEntry.Contains("环境") OrElse SearchEntry.Contains("run") OrElse SearchEntry.Contains("软件") OrElse
SearchEntry.Contains("jre") OrElse SearchEntry = "bin" OrElse SearchEntry.Contains("mc") OrElse
SearchEntry.Contains("soft") OrElse SearchEntry.Contains("cache") OrElse SearchEntry.Contains("temp") OrElse
SearchEntry.Contains("corretto") OrElse SearchEntry.Contains("roaming") OrElse SearchEntry.Contains("users") OrElse
SearchEntry.Contains("craft") OrElse SearchEntry.Contains("program") OrElse SearchEntry.Contains("世界") OrElse
SearchEntry.Contains("net") OrElse SearchEntry.Contains("游戏") OrElse SearchEntry.Contains("oracle") OrElse
SearchEntry.Contains("game") OrElse SearchEntry.Contains("file") OrElse SearchEntry.Contains("data") OrElse
SearchEntry.Contains("jvm") OrElse SearchEntry.Contains("服务") OrElse SearchEntry.Contains("server") OrElse
SearchEntry.Contains("客户") OrElse SearchEntry.Contains("client") OrElse SearchEntry.Contains("整合") OrElse
SearchEntry.Contains("应用") OrElse SearchEntry.Contains("运行") OrElse SearchEntry.Contains("前置") OrElse
SearchEntry.Contains("mojang") OrElse SearchEntry.Contains("官启") OrElse SearchEntry.Contains("新建文件夹") OrElse
SearchEntry.Contains("eclipse") OrElse SearchEntry.Contains("microsoft") OrElse SearchEntry.Contains("hotspot") OrElse
SearchEntry.Contains("runtime") OrElse SearchEntry.Contains("x86") OrElse SearchEntry.Contains("x64") OrElse
SearchEntry.Contains("forge") OrElse SearchEntry.Contains("原版") OrElse SearchEntry.Contains("optifine") OrElse
SearchEntry.Contains("官方") OrElse SearchEntry.Contains("启动") OrElse SearchEntry.Contains("hmcl") OrElse
SearchEntry.Contains("mod") OrElse SearchEntry.Contains("高清") OrElse SearchEntry.Contains("download") OrElse
SearchEntry.Contains("launch") OrElse SearchEntry.Contains("程序") OrElse SearchEntry.Contains("path") OrElse
SearchEntry.Contains("version") OrElse SearchEntry.Contains("baka") OrElse SearchEntry.Contains("pcl") OrElse
SearchEntry.Contains("zulu") OrElse
SearchEntry.Contains("local") OrElse SearchEntry.Contains("packages") OrElse SearchEntry.Contains("4297127d64ec6") OrElse '官启文件夹
SearchEntry.Contains("国服") OrElse SearchEntry.Contains("网易") OrElse SearchEntry.Contains("ext") OrElse '网易 Java 文件夹名
SearchEntry.Contains("netease") OrElse SearchEntry.Contains("1.") OrElse SearchEntry.Contains("启动") Then
If IsFullSearch OrElse FolderInfo.Parent.Name.ToLower = "users" OrElse
Keywords.Any(Function(w) SearchEntry.Contains(w)) OrElse SearchEntry = "bin" Then
JavaSearchFolder(FolderInfo, Results, Source)
End If
Next
@@ -113,10 +113,18 @@ Public Module ModLaunch
New LoaderTask(Of Process, Integer)("等待游戏窗口出现", AddressOf McLaunchWait) With {.ProgressWeight = 1},
New LoaderTask(Of Integer, Integer)("结束处理", AddressOf McLaunchEnd) With {.ProgressWeight = 1}
}
If Setup.Get("LaunchArgumentRam") Then
CType(Loaders(2), LoaderCombo(Of String)).Block = False
Loaders.Insert(3, New LoaderTask(Of Integer, Integer)("内存优化", AddressOf McLaunchMemoryOptimize) With {.ProgressWeight = 30})
End If
'内存优化
Select Case Setup.Get("VersionRamOptimize", Version:=McVersionCurrent)
Case 0 '全局
If Setup.Get("LaunchArgumentRam") Then '使用全局设置
CType(Loaders(2), LoaderCombo(Of String)).Block = False
Loaders.Insert(3, New LoaderTask(Of Integer, Integer)("内存优化", AddressOf McLaunchMemoryOptimize) With {.ProgressWeight = 30})
End If
Case 1 '开启
CType(Loaders(2), LoaderCombo(Of String)).Block = False
Loaders.Insert(3, New LoaderTask(Of Integer, Integer)("内存优化", AddressOf McLaunchMemoryOptimize) With {.ProgressWeight = 30})
Case 2 '关闭
End Select
Dim LaunchLoader As New LoaderCombo(Of Object)("Minecraft 启动", Loaders) With {.Show = False}
If McLoginLoader.State = LoadState.Finished Then McLoginLoader.State = LoadState.Waiting '要求重启登录主加载器,它会自行决定是否启动副加载器
'等待加载器执行并更新 UI
@@ -1072,8 +1080,8 @@ SystemBrowser:
Case 4
'自定义
Do Until McSkinSex(Uuid) = If(Setup.Get("LaunchSkinSlim"), "Alex", "Steve")
If Uuid.EndsWithF("FFFFF") Then Uuid = Mid(Uuid, 1, 32 - 5) & "00000"
Uuid = Mid(Uuid, 1, 32 - 5) & (Long.Parse(Right(Uuid, 5), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X").PadLeft(5, "0")
If Uuid.EndsWithF("FFFFF") Then Uuid = Uuid.Substring(0, 27) & "00000"
Uuid = Uuid.Substring(0, 27) & (Long.Parse(Uuid.Substring(27), Globalization.NumberStyles.AllowHexSpecifier) + 1).ToString("X").PadLeft(5, "0")
Loop
End Select
Return Uuid
@@ -1270,7 +1278,9 @@ SystemBrowser:
Public Function ExtractJavaWrapper() As String
Dim WrapperPath As String = GetJavaWrapperDir() & "\JavaWrapper.jar"
SyncLock ExtractJavaWrapperLock '避免 OptiFine 和 Forge 安装时同时释放 Java Wrapper 导致冲突
WriteFile(WrapperPath, GetResources("JavaWrapper"))
If Not WriteFile(WrapperPath, GetResources("JavaWrapper")) Then
Throw New FileNotFoundException("释放 Java Wrapper 失败")
End If
End SyncLock
Log("[Java] 已释放 Java Wrapper:" & WrapperPath)
Return WrapperPath
@@ -151,7 +151,7 @@ Public Module ModMinecraft
#Region "版本处理"
Public Const McVersionCacheVersion As Integer = 29
Public Const McVersionCacheVersion As Integer = 30
Private _McVersionCurrent As McVersion
Private _McVersionLast = 0 '为 0 以保证与 Nothing 不相同,使得 UI 显示可以正常初始化
@@ -290,7 +290,7 @@ Public Module ModMinecraft
Public ReadOnly Property Modable As Boolean
Get
If Not IsLoaded Then Load()
Return Version.HasFabric OrElse Version.HasForge OrElse Version.HasLiteLoader OrElse
Return Version.HasFabric OrElse Version.HasForge OrElse Version.HasLiteLoader OrElse Version.HasNeoForge OrElse
DisplayType = McVersionCardType.API '#223
End Get
End Property
@@ -345,7 +345,7 @@ Public Module ModMinecraft
End If
Next
End If
'从 Forge Arguments 中获取版本号
'从 Forge / NeoForge Arguments 中获取版本号
If JsonObject("arguments") IsNot Nothing AndAlso JsonObject("arguments")("game") IsNot Nothing Then
Dim Mark As Boolean = False
For Each Argument In JsonObject("arguments")("game")
@@ -715,8 +715,8 @@ Recheck:
'OptiFine
If RealJson.Contains("optifine") Then
State = McVersionState.OptiFine
Version.OptiFineVersion = If(RegexSeek(RealJson, "(?<=HD_U_)[^"":/]+"), "未知版本")
Version.HasOptiFine = True
Version.OptiFineVersion = If(RegexSeek(RealJson, "(?<=HD_U_)[^"":/]+"), "未知版本")
End If
'LiteLoader
If RealJson.Contains("liteloader") Then
@@ -727,14 +727,20 @@ Recheck:
'FUTURE: [Quilt 支持] 确认这里的玩意儿对不对
If RealJson.Contains("net.fabricmc:fabric-loader") OrElse RealJson.Contains("org.quiltmc:quilt-loader") Then
State = McVersionState.Fabric
Version.FabricVersion = If(RegexSeek(RealJson, "(?<=(net.fabricmc:fabric-loader:)|(org.quiltmc:quilt-loader:))[0-9\.]+(\+build.[0-9]+)?"), "未知版本").Replace("+build", "")
Version.HasFabric = True
ElseIf RealJson.Contains("minecraftforge") Then
Version.FabricVersion = If(RegexSeek(RealJson, "(?<=(net.fabricmc:fabric-loader:)|(org.quiltmc:quilt-loader:))[0-9\.]+(\+build.[0-9]+)?"), "未知版本").Replace("+build", "")
ElseIf RealJson.Contains("minecraftforge") AndAlso Not RealJson.Contains("net.neoforge") Then
State = McVersionState.Forge
Version.HasForge = True
Version.ForgeVersion = RegexSeek(RealJson, "(?<=forge:[0-9\.]+(_pre[0-9]*)?\-)[0-9\.]+")
If Version.ForgeVersion Is Nothing Then Version.ForgeVersion = RegexSeek(RealJson, "(?<=net\.minecraftforge:minecraftforge:)[0-9\.]+")
If Version.ForgeVersion Is Nothing Then Version.ForgeVersion = If(RegexSeek(RealJson, "(?<=net\.minecraftforge:fmlloader:[0-9\.]+-)[0-9\.]+"), "未知版本")
Version.HasForge = True
ElseIf RealJson.Contains("net.neoforge") Then
'1.20.1 JSON 范例:"--fml.forgeVersion", "47.1.99"
'1.20.2+ JSON 范例:"--fml.neoForgeVersion", "20.6.119-beta"
State = McVersionState.NeoForge
Version.HasNeoForge = True
Version.NeoForgeVersion = If(RegexSeek(RealJson, "(?<=orgeVersion"",[^""]*?"")[^""]+(?="",)"), "未知版本")
End If
Version.IsApiLoaded = True
End Select
@@ -752,6 +758,8 @@ ExitDataLoad:
Logo = PathImage & "Blocks/CobbleStone.png"
Case McVersionState.Forge
Logo = PathImage & "Blocks/Anvil.png"
Case McVersionState.NeoForge
Logo = PathImage & "Blocks/NeoForge.png"
Case McVersionState.Fabric
Logo = PathImage & "Blocks/Fabric.png"
Case McVersionState.OptiFine
@@ -780,7 +788,7 @@ ExitDataLoad:
End If
Case McVersionState.Old
Info = "远古版本"
Case McVersionState.Original, McVersionState.Forge, McVersionState.Fabric, McVersionState.OptiFine, McVersionState.LiteLoader
Case McVersionState.Original, McVersionState.Forge, McVersionState.NeoForge, McVersionState.Fabric, McVersionState.OptiFine, McVersionState.LiteLoader
Info = Version.ToString
Case McVersionState.Fool
Info = GetMcFoolName(Version.McName)
@@ -813,6 +821,7 @@ ExitDataLoad:
WriteIni(Path & "PCL\Setup.ini", "VersionOptiFine", Version.OptiFineVersion)
WriteIni(Path & "PCL\Setup.ini", "VersionLiteLoader", Version.HasLiteLoader)
WriteIni(Path & "PCL\Setup.ini", "VersionForge", Version.ForgeVersion)
WriteIni(Path & "PCL\Setup.ini", "VersionNeoForge", Version.NeoForgeVersion)
WriteIni(Path & "PCL\Setup.ini", "VersionApiCode", Version.SortCode)
WriteIni(Path & "PCL\Setup.ini", "VersionOriginal", Version.McName)
WriteIni(Path & "PCL\Setup.ini", "VersionOriginalMain", Version.McCodeMain)
@@ -852,6 +861,7 @@ ExitDataLoad:
OptiFine
Old
Forge
NeoForge
LiteLoader
Fabric
End Enum
@@ -903,6 +913,17 @@ ExitDataLoad:
''' </summary>
Public ForgeVersion As String = ""
'NeoForge
''' <summary>
''' 该版本是否安装了 NeoForge。
''' </summary>
Public HasNeoForge As Boolean = False
''' <summary>
''' NeoForge 版本号,如 21.0.2-beta、47.1.79。
''' </summary>
Public NeoForgeVersion As String = ""
'Fabric
''' <summary>
@@ -929,6 +950,7 @@ ExitDataLoad:
Public Overrides Function ToString() As String
ToString = ""
If HasForge Then ToString += ", Forge" & If(ForgeVersion = "未知版本", "", " " & ForgeVersion)
If HasNeoForge Then ToString += ", NeoForge" & If(NeoForgeVersion = "未知版本", "", " " & NeoForgeVersion)
If HasFabric Then ToString += ", Fabric" & If(FabricVersion = "未知版本", "", " " & FabricVersion)
If HasOptiFine Then ToString += ", OptiFine" & If(OptiFineVersion = "未知版本", "", " " & OptiFineVersion)
If HasLiteLoader Then ToString += ", LiteLoader"
@@ -955,15 +977,15 @@ ExitDataLoad:
Else
Throw New Exception("无效的 Fabric 版本:" & ForgeVersion)
End If
ElseIf HasForge Then
If ForgeVersion = "未知版本" Then Return 0
Dim SubVersions = ForgeVersion.Split(".")
ElseIf HasForge OrElse HasNeoForge Then
If ForgeVersion = "未知版本" AndAlso NeoForgeVersion = "未知版本" Then Return 0
Dim SubVersions = If(HasForge, ForgeVersion.Split("."), NeoForgeVersion.Split("."))
If SubVersions.Length = 4 Then
_SortCode = Val(SubVersions(0)) * 1000000 + Val(SubVersions(1)) * 10000 + Val(SubVersions(3))
ElseIf SubVersions.Length = 3 Then
_SortCode = Val(SubVersions(0)) * 1000000 + Val(SubVersions(1)) * 10000 + Val(SubVersions(2))
Else
Throw New Exception("无效的 Forge 版本:" & ForgeVersion)
Throw New Exception("无效的 Neo/Forge 版本:" & ForgeVersion)
End If
ElseIf HasOptiFine Then
If OptiFineVersion = "未知版本" Then Return 0
@@ -1175,6 +1197,7 @@ OnLoaded:
Dim VersionInfo As New McVersionInfo With {
.FabricVersion = ReadIni(Version.Path & "PCL\Setup.ini", "VersionFabric", ""),
.ForgeVersion = ReadIni(Version.Path & "PCL\Setup.ini", "VersionForge", ""),
.NeoForgeVersion = ReadIni(Version.Path & "PCL\Setup.ini", "VersionNeoForge", ""),
.OptiFineVersion = ReadIni(Version.Path & "PCL\Setup.ini", "VersionOptiFine", ""),
.HasLiteLoader = ReadIni(Version.Path & "PCL\Setup.ini", "VersionLiteLoader", False),
.SortCode = ReadIni(Version.Path & "PCL\Setup.ini", "VersionApiCode", -1),
@@ -1183,9 +1206,10 @@ OnLoaded:
.McCodeSub = ReadIni(Version.Path & "PCL\Setup.ini", "VersionOriginalSub", -1),
.IsApiLoaded = True
}
VersionInfo.HasFabric = VersionInfo.FabricVersion.Count > 1
VersionInfo.HasForge = VersionInfo.ForgeVersion.Count > 1
VersionInfo.HasOptiFine = VersionInfo.OptiFineVersion.Count > 1
VersionInfo.HasFabric = VersionInfo.FabricVersion.Any()
VersionInfo.HasForge = VersionInfo.ForgeVersion.Any()
VersionInfo.HasNeoForge = VersionInfo.NeoForgeVersion.Any()
VersionInfo.HasOptiFine = VersionInfo.OptiFineVersion.Any()
Version.Version = VersionInfo
End If
@@ -1273,7 +1297,7 @@ OnLoaded:
McVersionFilter(VersionList, VersionListOriginal, {McVersionState.Fool}, McVersionCardType.Fool)
'筛选 API 版本
McVersionFilter(VersionList, VersionListOriginal, {McVersionState.Forge, McVersionState.LiteLoader, McVersionState.Fabric}, McVersionCardType.API)
McVersionFilter(VersionList, VersionListOriginal, {McVersionState.Forge, McVersionState.NeoForge, McVersionState.LiteLoader, McVersionState.Fabric}, McVersionCardType.API)
'将老版本预先分类入不常用,只剩余原版、快照、OptiFine
Dim VersionUseful As New List(Of McVersion)
@@ -1407,7 +1431,7 @@ OnLoaded:
End Function)
End If
'API 版本:优先按版本排序,此后【先放 Fabric,再放 Forge(按版本号从高到低排序),最后放 LiteLoader(按名称排序)】
'API 版本:优先按版本排序,此后【先放 Fabric,再放 Neo/Forge(按版本号从高到低排序),最后放 LiteLoader(按名称排序)】
If ResultVersionList.ContainsKey(McVersionCardType.API) Then
ResultVersionList(McVersionCardType.API) = Sort(ResultVersionList(McVersionCardType.API),
Function(Left As McVersion, Right As McVersion)
@@ -1417,6 +1441,8 @@ OnLoaded:
Else
If Left.Version.HasFabric Xor Right.Version.HasFabric Then
Return Left.Version.HasFabric
ElseIf Left.Version.HasNeoForge Xor Right.Version.HasNeoForge Then
Return Left.Version.HasNeoForge
ElseIf Left.Version.HasForge Xor Right.Version.HasForge Then
Return Left.Version.HasForge
ElseIf Not Left.Version.SortCode <> Right.Version.SortCode Then
@@ -1649,7 +1675,7 @@ OnLoaded:
Return _Url
End Get
Set(value As String)
'孤儿 Forge 作者喜欢把没有的 URL 写个空字符串
'孤儿 Forge 作者喜欢把没有 URL 的写个空字符串
_Url = If(String.IsNullOrWhiteSpace(value), Nothing, value)
End Set
End Property
@@ -1666,15 +1692,6 @@ OnLoaded:
End Get
End Property
''' <summary>
''' 原 Json 中 Name 项最后一部分的版本号。
''' </summary>
Public ReadOnly Property Version As String
Get
Dim Splited = OriginalName.Split(":")
Return Splited(Splited.Count - 1)
End Get
End Property
''' <summary>
''' 原 Json 中的 Name 项。
''' </summary>
Public OriginalName As String
@@ -1755,7 +1772,7 @@ OnLoaded:
'根据 Inherit 获取最深层版本
Dim OriginalVersion As McVersion = Version
'1.17+ 的 Forge 不寻找 Inherit
If Not (Version.Version.HasForge AndAlso Version.Version.McCodeMain >= 17) Then
If Not ((Version.Version.HasForge OrElse Version.Version.HasNeoForge) AndAlso Version.Version.McCodeMain >= 17) Then
Do Until OriginalVersion.InheritVersion = ""
If OriginalVersion.InheritVersion = OriginalVersion.Name Then Exit Do
OriginalVersion = New McVersion(PathMcFolder & "versions\" & OriginalVersion.InheritVersion & "\")
@@ -1840,13 +1857,14 @@ OnLoaded:
Try
If Library("downloads") IsNot Nothing AndAlso Library("downloads")("artifact") IsNot Nothing Then
BasicArray.Add(New McLibToken With {
.IsJumpLoader = IsJumpLoader,
.OriginalName = Library("name"),
.Url = If(RootUrl, Library("downloads")("artifact")("url")),
.LocalPath = If(Library("downloads")("artifact")("path") Is Nothing, McLibGet(Library("name"), CustomMcFolder:=CustomMcFolder), CustomMcFolder & "libraries\" & Library("downloads")("artifact")("path").ToString.Replace("/", "\")),
.Size = Val(Library("downloads")("artifact")("size").ToString),
.IsNatives = False,
.SHA1 = Library("downloads")("artifact")("sha1")?.ToString})
.IsJumpLoader = IsJumpLoader,
.OriginalName = Library("name"),
.Url = If(RootUrl, Library("downloads")("artifact")("url")),
.LocalPath = If(Library("downloads")("artifact")("path") Is Nothing, McLibGet(Library("name"),
CustomMcFolder:=CustomMcFolder), CustomMcFolder & "libraries\" & Library("downloads")("artifact")("path").ToString.Replace("/", "\")),
.Size = Val(Library("downloads")("artifact")("size").ToString),
.IsNatives = False,
.SHA1 = Library("downloads")("artifact")("sha1")?.ToString})
Else
BasicArray.Add(New McLibToken With {.IsJumpLoader = IsJumpLoader, .OriginalName = Library("name"), .Url = RootUrl, .LocalPath = LocalPath, .Size = 0, .IsNatives = False, .SHA1 = Nothing})
End If
@@ -1880,15 +1898,25 @@ OnLoaded:
'去重
Dim ResultArray As New Dictionary(Of String, McLibToken)
Dim GetVersion =
Function(Token As McLibToken) As String
'测试例:
'D:\Minecraft\test\libraries\net\neoforged\mergetool\2.0.0\mergetool-2.0.0-api.jar
'D:\Minecraft\test\libraries\org\apache\commons\commons-collections4\4.2\commons-collections4-4.2.jar
'D:\Minecraft\test\libraries\com\google\guava\guava\31.1-jre\guava-31.1-jre.jar
Return GetFolderNameFromPath(GetPathFromFullPath(Token.LocalPath))
End Function
For i = 0 To BasicArray.Count - 1
Dim Key As String = BasicArray(i).Name & BasicArray(i).IsNatives.ToString & BasicArray(i).IsJumpLoader.ToString
If ResultArray.ContainsKey(Key) Then
If BasicArray(i).Version <> ResultArray(Key).Version AndAlso KeepSameNameDifferentVersionResult Then
Log($"[Minecraft] 发现疑似重复的支持库:{BasicArray(i)} 与 {ResultArray(Key)}")
Dim BasicArrayVersion As String = GetVersion(BasicArray(i))
Dim ResultArrayVersion As String = GetVersion(ResultArray(Key))
If BasicArrayVersion <> ResultArrayVersion AndAlso KeepSameNameDifferentVersionResult Then
Log($"[Minecraft] 发现疑似重复的支持库:{BasicArray(i)} ({BasicArrayVersion}) 与 {ResultArray(Key)} ({ResultArrayVersion})")
ResultArray.Add(Key & GetUuid(), BasicArray(i))
Else
Log($"[Minecraft] 发现重复的支持库:{BasicArray(i)} 与 {ResultArray(Key)},已忽略其中之一")
If VersionSortBoolean(BasicArray(i).Version, ResultArray(Key).Version) Then
Log($"[Minecraft] 发现重复的支持库:{BasicArray(i)} ({BasicArrayVersion}) 与 {ResultArray(Key)} ({ResultArrayVersion}),已忽略其中之一")
If VersionSortBoolean(BasicArrayVersion, ResultArrayVersion) Then
ResultArray(Key) = BasicArray(i)
End If
End If
@@ -1948,6 +1976,7 @@ OnLoaded:
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 登录转接
@@ -1997,8 +2026,13 @@ OnLoaded:
If Token.Url IsNot Nothing Then
'获取 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("maven") Then Urls.Insert(0, Token.Url.Replace(Mid(Token.Url, 1, Token.Url.IndexOfF("maven")), "https://bmclapi2.bangbang93.com/").Replace("maven.fabricmc.net", "maven").Replace("maven.minecraftforge.net", "maven"))
If Token.Url.Contains("launcher.mojang.com/v1/objects") Then
Urls = DlSourceLauncherOrMetaGet(Token.Url).ToList() 'Mappings
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/").
Replace("maven.fabricmc.net", "maven").Replace("maven.minecraftforge.net", "maven").Replace("maven.neoforged.net/releases", "maven"))
End If
End If
If Token.LocalPath.Contains("transformer-discovery-service") Then
'Transformer 文件释放
@@ -887,7 +887,7 @@ Finished:
ModList.Add(ModEntry)
'读取 Comp 缓存
If ModEntry.State = McMod.McModState.Unavaliable Then Continue For
Dim CacheKey = ModEntry.ModrinthHash & PageVersionLeft.Version.Version.McName
Dim CacheKey = ModEntry.ModrinthHash & PageVersionLeft.Version.Version.McName & GetTargetModLoaders().Join("")
If Cache.ContainsKey(CacheKey) Then
ModEntry.FromJson(Cache(CacheKey))
'如果缓存中的信息在 6 小时以内更新过,则无需重新获取
@@ -923,20 +923,15 @@ Finished:
Throw
End Try
End Sub
'联网加载 Mod 详情
Private Const LocalModCacheVersion As Integer = 4
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
Dim Cache As JObject = Loader.Input.Value
'获取作为检查目标的加载器和版本
Dim TargetMcVersion As McVersionInfo = PageVersionLeft.Version.Version
Dim ModLoaders As New List(Of CompModLoaderType)
If TargetMcVersion.HasForge Then ModLoaders.Add(CompModLoaderType.Forge)
If TargetMcVersion.HasFabric Then ModLoaders.Add(CompModLoaderType.Fabric)
If TargetMcVersion.HasLiteLoader Then ModLoaders.Add(CompModLoaderType.LiteLoader)
If Not ModLoaders.Any() Then ModLoaders.AddRange({CompModLoaderType.Forge, CompModLoaderType.Fabric, CompModLoaderType.LiteLoader, CompModLoaderType.Quilt})
Dim ModLoaders = GetTargetModLoaders()
Dim McVersion = TargetMcVersion.McName
'暂不向下扩展检查的 MC 小版本
'例如:Mod 在更新 1.16.5 后,对早期的 1.16.2 版本发布了修补补丁,这会导致 PCL 将 1.16.5 版本的 Mod 降级到 1.16.2
@@ -1136,10 +1131,19 @@ Finished:
If Not Mods.Any() Then Exit Sub
For Each Entry In Mods 'TODO: Bookshelf 的 Logo 会在两个网站间横跳
Entry.CompLoaded = SucceedThreadCount = 2
Cache(Entry.ModrinthHash & McVersion) = Entry.ToJson()
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)))
End Sub
Private Function GetTargetModLoaders() As List(Of CompModLoaderType)
Dim ModLoaders As New List(Of CompModLoaderType)
If PageVersionLeft.Version.Version.HasForge Then ModLoaders.Add(CompModLoaderType.Forge)
If PageVersionLeft.Version.Version.HasNeoForge Then ModLoaders.Add(CompModLoaderType.NeoForge)
If PageVersionLeft.Version.Version.HasFabric Then ModLoaders.Add(CompModLoaderType.Fabric)
If PageVersionLeft.Version.Version.HasLiteLoader Then ModLoaders.Add(CompModLoaderType.LiteLoader)
If Not ModLoaders.Any() Then ModLoaders.AddRange({CompModLoaderType.Forge, CompModLoaderType.NeoForge, CompModLoaderType.Fabric, CompModLoaderType.LiteLoader, CompModLoaderType.Quilt})
Return ModLoaders
End Function
#If DEBUG Then
''' <summary>
@@ -25,6 +25,7 @@ Public Module ModModpack
Archive = New ZipArchive(New FileStream(File, FileMode.Open, FileAccess.Read, FileShare.ReadWrite))
'从根目录判断整合包类型
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)
If Archive.GetEntry("modrinth.index.json") IsNot Nothing Then PackType = 4 : Exit Try 'Modrinth 整合包
If Archive.GetEntry("manifest.json") IsNot Nothing Then
Dim Json As JObject = GetJson(ReadFile(Archive.GetEntry("manifest.json").Open, Encoding.UTF8))
@@ -35,7 +36,6 @@ Public Module ModModpack
End If
End If
If Archive.GetEntry("modpack.json") IsNot Nothing Then PackType = 1 : Exit Try 'HMCL 整合包
If Archive.GetEntry("mmc-pack.json") IsNot Nothing Then PackType = 2 : Exit Try 'MMC 整合包
'从一级目录判断整合包类型
For Each Entry In Archive.Entries
Dim FullNames As String() = Entry.FullName.Split("/")
@@ -183,6 +183,7 @@ Retry:
'获取 Mod API 版本信息
Dim ForgeVersion As String = Nothing
Dim NeoForgeVersion As String = Nothing
Dim FabricVersion As String = Nothing
For Each Entry In If(Json("minecraft")("modLoaders"), {})
Dim Id As String = If(Entry("id"), "").ToString.ToLower
@@ -194,16 +195,25 @@ Retry:
End If
Try
Log("[ModPack] 整合包 Forge 版本:" & Id)
ForgeVersion = Id.Split("-")(1)
ForgeVersion = Id.Replace("forge-", "")
Exit For
Catch ex As Exception
Log(ex, "读取整合包 Forge 版本失败:" & Id)
End Try
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
ElseIf Id.StartsWithF("fabric-") Then
'Fabric 指定
Try
Log("[ModPack] 整合包 Fabric 版本:" & Id)
FabricVersion = Id.Split("-")(1)
FabricVersion = Id.Replace("fabric-", "")
Exit For
Catch ex As Exception
Log(ex, "读取整合包 Fabric 版本失败:" & Id)
@@ -271,19 +281,23 @@ Retry:
'建立 CompFile
Dim File As New CompFile(ModJson, CompType.Mod)
If Not File.Available Then Continue For
'根据 modules 和文件名后缀判断是资源包还是 Mod
Dim IsResourcePack As Boolean
'根据 modules 和文件名后缀判断资源类型
Dim TargetFolder As String
If ModJson("modules").Any Then 'modules 可能返回 null(#1006)
Dim ModuleNames = CType(ModJson("modules"), JArray).Select(Function(l) l("name").ToString).ToList
IsResourcePack =
(Not ModuleNames.Contains("META-INF")) AndAlso (Not ModuleNames.Contains("mcmod.info")) AndAlso '不包含 META-INF 或 mcmod.info
ModuleNames.Contains("pack.mcmeta") AndAlso '包含 pack.mcmeta
(Not File.FileName.EndsWithF(".jar", True)) '文件后缀不是 .jar
If ModuleNames.Contains("META-INF") OrElse ModuleNames.Contains("mcmod.info") OrElse
File.FileName.EndsWithF(".jar", True) Then
TargetFolder = "mods"
ElseIf ModuleNames.Contains("pack.mcmeta") Then
TargetFolder = "resourcepacks"
Else
TargetFolder = "shaderpacks"
End If
Else
IsResourcePack = False
TargetFolder = "mods"
End If
'实际的添加
FileList.Add(Id, File.ToNetFile($"{PathMcFolder}versions\{VersionName}\{If(IsResourcePack, "resourcepacks", "mods")}\"))
FileList.Add(Id, File.ToNetFile($"{PathMcFolder}versions\{VersionName}\{TargetFolder}\"))
Task.Progress += 1 / (1 + ModList.Count)
Next
Task.Output = FileList.Values.ToList
@@ -301,6 +315,7 @@ Retry:
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
.MinecraftName = Json("minecraft")("version").ToString,
.ForgeVersion = ForgeVersion,
.NeoForgeVersion = NeoForgeVersion,
.FabricVersion = FabricVersion
}
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
@@ -368,6 +383,7 @@ Retry:
'获取 Mod API 版本信息
Dim MinecraftVersion As String = Nothing
Dim ForgeVersion As String = Nothing
Dim NeoForgeVersion As String = Nothing
Dim FabricVersion As String = Nothing
For Each Entry As JProperty In If(Json("dependencies"), {})
Select Case Entry.Name.ToLower
@@ -376,6 +392,9 @@ Retry:
Case "forge" 'eg. 14.23.5.2859 / 1.19-41.1.0
ForgeVersion = Entry.Value.ToString
Log("[ModPack] 整合包 Forge 版本:" & ForgeVersion)
Case "neoforge", "neo-forge" 'eg. 20.6.98-beta
NeoForgeVersion = Entry.Value.ToString
Log("[ModPack] 整合包 NeoForge 版本:" & NeoForgeVersion)
Case "fabric-loader" 'eg. 0.14.14
FabricVersion = Entry.Value.ToString
Log("[ModPack] 整合包 Fabric 版本:" & FabricVersion)
@@ -447,6 +466,7 @@ Retry:
.TargetVersionFolder = $"{PathMcFolder}versions\{VersionName}\",
.MinecraftName = MinecraftVersion,
.ForgeVersion = ForgeVersion,
.NeoForgeVersion = NeoForgeVersion,
.FabricVersion = FabricVersion
}
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
@@ -676,6 +696,8 @@ Retry:
Request.MinecraftName = Component("version")
Case "net.minecraftforge"
Request.ForgeVersion = Component("version")
Case "net.neoforged"
Request.NeoForgeVersion = Component("version")
Case "net.fabricmc.fabric-loader"
Request.FabricVersion = Component("version")
Case "org.quiltmc.quilt-loader" 'eg. 1.0.0
@@ -772,6 +794,7 @@ Retry:
.MinecraftName = Addons("game"),
.OptiFineVersion = If(Addons.ContainsKey("optifine"), Addons("optifine"), Nothing),
.ForgeVersion = If(Addons.ContainsKey("forge"), Addons("forge"), Nothing),
.NeoForgeVersion = If(Addons.ContainsKey("neoforge"), Addons("neoforge"), Nothing),
.FabricVersion = If(Addons.ContainsKey("fabric"), Addons("fabric"), Nothing)
}
Dim MergeLoaders As List(Of LoaderBase) = McInstallLoader(Request, True)
+30 -20
View File
@@ -21,28 +21,38 @@
OpenWebsite(Data(0))
Case "打开文件", "打开帮助"
RunInThread(Sub()
Try
'确认实际路径
Dim ActualPaths = GetEventAbsoluteUrls(Data(0), Type)
Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1)
'执行
If Type = "打开文件" Then
Dim Info As New ProcessStartInfo With {
.Arguments = If(Data.Length >= 2, Data(1), ""),
.FileName = Location,
.WorkingDirectory = WorkingDir
}
Process.Start(Info)
Else '打开帮助
PageOtherHelp.EnterHelpPage(Location)
End If
Catch ex As Exception
Log(ex, "执行打开类自定义事件失败", LogLevel.Msgbox)
End Try
End Sub)
RunInThread(
Sub()
Try
'确认实际路径
Dim ActualPaths = GetEventAbsoluteUrls(Data(0), Type)
Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1)
Log($"[Control] 打开类自定义事件实际路径:{Location},工作目录:{WorkingDir}")
'执行
If Type = "打开文件" Then
Dim Info As New ProcessStartInfo With {
.Arguments = If(Data.Length >= 2, Data(1), ""),
.FileName = Location,
.WorkingDirectory = WorkingDir
}
Process.Start(Info)
Else '打开帮助
PageOtherHelp.EnterHelpPage(Location)
End If
Catch ex As Exception
Log(ex, "执行打开类自定义事件失败", LogLevel.Msgbox)
End Try
End Sub)
Case "启动游戏"
If Data(0) = "\current" Then
If McVersionCurrent Is Nothing Then
Hint("请先选择一个 Minecraft 版本!", HintType.Critical)
Exit Sub
Else
Data(0) = McVersionCurrent.Name
End If
End If
If McLaunchStart(New McLaunchOptions With
{.ServerIp = If(Data.Length >= 2, Data(1), Nothing), .Version = New McVersion(Data(0))}) Then
Hint("正在启动 " & Data(0) & "……")
@@ -394,6 +394,7 @@ EndHint:
Public FrmDownloadOptiFine As PageDownloadOptiFine
Public FrmDownloadLiteLoader As PageDownloadLiteLoader
Public FrmDownloadForge As PageDownloadForge
Public FrmDownloadNeoForge As PageDownloadNeoForge
Public FrmDownloadFabric As PageDownloadFabric
Public FrmDownloadMod As PageDownloadMod
Public FrmDownloadPack As PageDownloadPack
+16 -6
View File
@@ -69,16 +69,25 @@
Else
'有背景音乐
FrmMain.BtnExtraMusic.Show = True
Dim ToolTipText As String = "正在播放:" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
Dim ToolTipText As String
If MusicState = MusicStates.Pause Then
FrmMain.BtnExtraMusic.Logo = Logo.IconPlay
FrmMain.BtnExtraMusic.LogoScale = 0.8
If MusicAllList.Count > 1 Then ToolTipText += vbCrLf & "左键播放,右键播放下一曲。"
ToolTipText = "已暂停:" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
If MusicAllList.Count > 1 Then
ToolTipText += vbCrLf & "左键恢复播放,右键播放下一曲。"
Else
ToolTipText += vbCrLf & "左键恢复播放,右键重新从头播放。"
End If
Else
FrmMain.BtnExtraMusic.Logo = Logo.IconMusic
FrmMain.BtnExtraMusic.LogoScale = 1
If MusicAllList.Count > 1 Then ToolTipText += vbCrLf & "左键暂停,右键播放下一曲。"
ToolTipText = "正在播放:" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
If MusicAllList.Count > 1 Then
ToolTipText += vbCrLf & "左键暂停,右键播放下一曲。"
Else
ToolTipText += vbCrLf & "左键暂停,右键重新从头播放。"
End If
End If
FrmMain.BtnExtraMusic.ToolTip = ToolTipText
ToolTipService.SetVerticalOffset(FrmMain.BtnExtraMusic, If(ToolTipText.Contains(vbLf), 10, 16))
@@ -115,13 +124,14 @@
''' </summary>
Public Sub MusicControlNext()
If MusicAllList.Count = 1 Then
Hint("播放列表中仅有一首歌曲!")
MusicStartPlay(MusicCurrent)
Hint("重新播放:" & GetFileNameFromPath(MusicCurrent), HintType.Finish)
Else
Dim Address As String = DequeueNextMusicAddress()
MusicStartPlay(Address)
Hint("正在播放:" & GetFileNameFromPath(Address), HintType.Finish)
MusicRefreshUI()
End If
MusicRefreshUI()
End Sub
#End Region
@@ -252,6 +252,7 @@ Friend Module ModSecret
Return False
End Function
Public Function DonateCodeInput() As Boolean?
Return Nothing
End Function
#End Region