This commit is contained in:
龙腾猫跃
2023-08-15 16:38:52 +08:00
parent e1e084aea3
commit 79778490d5
21 changed files with 753 additions and 231 deletions
@@ -11,12 +11,12 @@ Public Module ModBase
#Region "声明"
'下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.6.4" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.6.4." & VersionBranchCode '标准格式的四段式版本号
Public Const VersionBaseName As String = "2.6.5" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.6.5." & VersionBranchCode '标准格式的四段式版本号
#If BETA Then
Public Const VersionCode As Integer = 296 'Release
#Else
Public Const VersionCode As Integer = 298 'Snapshot
Public Const VersionCode As Integer = 299 'Snapshot
#End If
'自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -106,15 +106,15 @@ Retry:
Retry:
Select Case RetryCount
Case 0 '正常尝试
Return NetGetCodeRequest(Url, Encode, 10000, IsJson, Accept)
Return NetGetCodeByRequestOnce(Url, Encode, 10000, IsJson, Accept)
Case 1 '慢速重试
Thread.Sleep(500)
Return NetGetCodeRequest(If(BackupUrl, Url), Encode, 30000, IsJson, Accept)
Return NetGetCodeByRequestOnce(If(BackupUrl, Url), Encode, 30000, IsJson, Accept)
Case Else '快速重试
If GetTimeTick() - StartTime > 5500 Then
'若前两次加载耗费 5 秒以上,才进行重试
Thread.Sleep(500)
Return NetGetCodeRequest(If(BackupUrl, Url), Encode, 4000, IsJson, Accept)
Return NetGetCodeByRequestOnce(If(BackupUrl, Url), Encode, 4000, IsJson, Accept)
Else
Throw RetryException
End If
@@ -148,7 +148,7 @@ Retry:
For i = 1 To 4
Dim th As New Thread(Sub()
Try
RequestResult = NetGetCodeRequest(Url, Encode, 30000, IsJson, Accept)
RequestResult = NetGetCodeByRequestOnce(Url, Encode, 30000, IsJson, Accept)
Catch ex As Exception
FailCount += 1
RequestEx = ex
@@ -182,10 +182,10 @@ RequestFinished:
Loop
Throw New Exception("未知错误")
End Function
Private Function NetGetCodeRequest(Url As String, Encode As Encoding, Timeout As Integer, IsJson As Boolean, Accept As String)
Public Function NetGetCodeByRequestOnce(Url As String, Optional Encode As Encoding = Nothing, Optional Timeout As Integer = 30000, Optional IsJson As Boolean = False, Optional Accept As String = "")
If RunInUi() AndAlso Not Url.Contains("//127.") Then Throw New Exception("在 UI 线程执行了网络请求")
Url = SecretCdnSign(Url)
Log("[Net] 获取网络结果:" & Url & ",最大超时 " & Timeout)
Log($"[Net] 获取网络结果:{Url},超时 {Timeout}ms{If(IsJson, ",要求 json", "")}")
Dim Request As HttpWebRequest = WebRequest.Create(Url)
Dim Result As New List(Of Byte)
Try
@@ -269,6 +269,8 @@ RequestFinished:
'下载
Using Client As New WebClient
Try
Client.Headers(HttpRequestHeader.UserAgent) = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
Client.Headers(HttpRequestHeader.Referer) = "http://" & VersionCode & ".pcl2.server/"
Client.DownloadFile(Url, LocalFile)
Catch ex As Exception
Throw New WebException("直接下载文件失败(" & Url & ")。", ex)
@@ -111,8 +111,9 @@
IsJre = Not File.Exists(PathFolder & "javac.exe")
'运行 -version
Output = ShellAndGetOutput(PathFolder & "java.exe", "-version", 15000).ToLower
If Output = "" Then Throw New Exception("尝试运行该 Java 失败")
If Output = "" Then Throw New ApplicationException("尝试运行该 Java 失败")
If ModeDebug Then Log("[Java] Java 检查输出:" & PathFolder & "java.exe" & vbCrLf & Output)
If Output.Contains("/lib/ext exists") Then Throw New ApplicationException("无法运行该 Java,请在删除 Java 文件夹中的 /lib/ext 文件夹后再试")
'获取详细信息
Dim VersionString = If(RegexSeek(Output, "(?<=version "")[^""]+"), If(RegexSeek(Output, "(?<=openjdk )[0-9]+"), "")).Replace("_", ".").Split("-").First
Do While VersionString.Split(".").Count < 4
@@ -122,6 +123,7 @@
VersionString = "1." & VersionString
End If
Loop
If VersionString = "" Then Throw New ApplicationException($"未找到该 Java 的版本号{If(Output.Length < 500, $"{vbCrLf}输出为:{vbCrLf}{Output}", "")}")
Version = New Version(VersionString)
If Version.Minor = 0 Then
Log("[Java] 疑似 X.0.X.X 格式版本号:" & Version.ToString)
@@ -129,10 +131,10 @@
End If
Is64Bit = Output.Contains("64-bit")
If Version.Minor <= 4 OrElse Version.Minor >= 25 Then Throw New Exception("分析详细信息失败,获取的版本为 " & Version.ToString)
'基于 #2249 发现的 JRE 17 似乎也导致了 Forge 安装失败,干脆禁用更多版本的 JRE
If IsJre AndAlso VersionCode >= 16 Then Throw New Exception("由于高版本 JRE 对 Minecraft 的兼容性很差,因此不再允许使用")
''无论如何不允许使用 JRE 16,它完全是炸的,安 OptiFine、Forge 和启动 MC 都会炸
'If IsJre AndAlso VersionCode = 16 Then Throw New Exception("由于 JRE 16 对 Minecraft 的兼容性很差,因此不再允许使用")
'基于 #2249 发现 JRE 17 似乎也导致了 Forge 安装失败,干脆禁用更多版本的 JRE
If IsJre AndAlso VersionCode >= 16 Then Throw New Exception("由于高版本 JRE 对游戏的兼容性很差,因此不再允许使用。你可以使用对应版本的 JDK,而非 JRE!")
Catch ex As ApplicationException
Throw ex
Catch ex As Exception
Log("[Java] 检查失败的 Java 输出:" & PathFolder & "java.exe" & vbCrLf & If(Output, "无程序输出"))
Throw New Exception("检查 Java 失败(" & If(PathJavaw, "Nothing") & ")", ex)
@@ -659,7 +661,7 @@ Wait:
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("software") OrElse SearchEntry.Contains("cache") OrElse SearchEntry.Contains("temp") 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
@@ -675,7 +677,7 @@ Wait:
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("local") OrElse SearchEntry.Contains("packages") OrElse SearchEntry.Contains("4297127D64EC6") 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
JavaSearchFolder(FolderInfo, Results, Source)
@@ -1120,8 +1120,8 @@ SystemBrowser:
ElseIf McVersionCurrent.Version.McCodeMain >= 8 AndAlso McVersionCurrent.Version.McCodeMain <= 11 Then
'1.8 - 1.11:必须恰好 Java 8
MinVer = New Version(1, 8, 0, 0) : MaxVer = New Version(1, 8, 999, 999)
ElseIf McVersionCurrent.Version.McCodeMain = 12 AndAlso McVersionCurrent.Version.HasForge Then
'1.12:若安装了 Forge,最高 Java 8
ElseIf McVersionCurrent.Version.McCodeMain = 12 Then
'1.12:最高 Java 8
MaxVer = New Version(1, 8, 999, 999)
End If
End If
@@ -1843,10 +1843,14 @@ NextVersion:
Else
PackFormat = 12
End If
Case 20, 99 '99 是快照版
PackFormat = 15
Case Else
PackFormat = 16
Case 20
If McVersionCurrent.Version.McCodeSub <= 1 Then
PackFormat = 15
Else
PackFormat = 17
End If
Case Else '快照版是 99
PackFormat = 17
'https://minecraft.fandom.com/zh/wiki/数据包#数据包版本
End Select
McLaunchLog("正在构建自定义皮肤资源包,格式为:" & PackFormat)
@@ -1,7 +1,4 @@
Imports System.IO.Compression
Imports NAudio.Gui
Public Module ModMinecraft
Public Module ModMinecraft
#Region "文件夹"
@@ -272,7 +272,7 @@
If Not MinecraftWindowName.StartsWith("FML") Then
'已找到 Minecraft 窗口
WindowHandle = MinecraftWindowHandle
WatcherLog("Minecraft 窗口已加载:" & MinecraftWindowName & "(" & MinecraftWindowHandle.ToInt64 & ")")
WatcherLog($"Minecraft 窗口已加载:{MinecraftWindowName}({MinecraftWindowHandle.ToInt64})")
IsWindowFinished = True
'最大化
If Setup.Get("LaunchArgumentWindowType") = 4 Then
@@ -282,6 +282,7 @@
'……虽然我很想这样说,但总有人反馈,算了
Thread.Sleep(2000)
ShowWindow(WindowHandle, 3)
WatcherLog($"已最大化 Minecraft 窗口:{MinecraftWindowHandle.ToInt64}")
Catch ex As Exception
Log(ex, "最大化 Minecraft 窗口时出现错误")
End Try
+4 -4
View File
@@ -23,11 +23,9 @@
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 {
@@ -39,13 +37,14 @@
Else '打开帮助
PageOtherHelp.EnterHelpPage(Location)
End If
Catch ex As Exception
Log(ex, "执行打开类自定义事件失败", LogLevel.Msgbox)
End Try
End Sub)
Case "启动游戏"
If McLaunchStart(New McLaunchOptions With {.ServerIp = If(Data.Length >= 2, Data(1), Nothing), .Version = New McVersion(Data(0))}) Then
If McLaunchStart(New McLaunchOptions With
{.ServerIp = If(Data.Length >= 2, Data(1), Nothing), .Version = New McVersion(Data(0))}) Then
Hint("正在启动 " & Data(0) & "……")
End If
@@ -54,6 +53,7 @@
Case "刷新主页"
FrmLaunchRight.ForceRefresh()
If Data(0) = "" Then Hint("已刷新主页!", HintType.Finish)
Case "刷新帮助"
PageOtherLeft.RefreshHelp()
+14 -14
View File
@@ -5,7 +5,7 @@
''' <summary>
''' 接下来要播放的音乐文件路径。未初始化时为 Nothing。
''' </summary>
Public MusicToplayList As List(Of String) = Nothing
Public MusicWaitingList As List(Of String) = Nothing
''' <summary>
''' 全部音乐文件路径。未初始化时为 Nothing。
''' </summary>
@@ -31,11 +31,11 @@
Next
End If
'打乱顺序播放
MusicToplayList = If(Setup.Get("UiMusicRandom"), Shuffle(New List(Of String)(MusicAllList)), New List(Of String)(MusicAllList))
If Not IgnoreFirst = "" AndAlso Not MusicToplayList.Count = 0 AndAlso MusicToplayList(0) = IgnoreFirst Then
MusicWaitingList = If(Setup.Get("UiMusicRandom"), Shuffle(New List(Of String)(MusicAllList)), New List(Of String)(MusicAllList))
If Not IgnoreFirst = "" AndAlso Not MusicWaitingList.Count = 0 AndAlso MusicWaitingList(0) = IgnoreFirst Then
'若需要避免成为第一项的为第一项,则将它放在最后
MusicToplayList.RemoveAt(0)
MusicToplayList.Add(IgnoreFirst)
MusicWaitingList.RemoveAt(0)
MusicWaitingList.Add(IgnoreFirst)
End If
Catch ex As Exception
Log(ex, "初始化音乐列表失败", LogLevel.Feedback)
@@ -46,12 +46,11 @@
''' </summary>
Private Function DequeueNextMusicAddress() As String
'初始化,确保存在音乐
If MusicAllList Is Nothing Then MusicListInit(False)
If MusicAllList.Count = 0 Then Throw New Exception("在没有音乐时尝试获取音乐路径")
If MusicAllList Is Nothing OrElse MusicAllList.Count = 0 Then MusicListInit(False)
'出列下一个音乐,如果出列结束则生成新列表
DequeueNextMusicAddress = MusicToplayList(0)
MusicToplayList.RemoveAt(0)
If MusicToplayList.Count = 0 Then MusicListInit(False, DequeueNextMusicAddress)
DequeueNextMusicAddress = MusicWaitingList(0)
MusicWaitingList.RemoveAt(0)
If MusicWaitingList.Count = 0 Then MusicListInit(False, DequeueNextMusicAddress)
End Function
#End Region
@@ -106,7 +105,8 @@
Case MusicStates.Play
MusicPause()
Case Else
Hint("音乐目前为停止状态!", HintType.Critical)
Log("[Music] 音乐目前为停止状态,已强制尝试开始播放", LogLevel.Debug)
MusicRefreshPlay(False)
End Select
End If
End Sub
@@ -212,15 +212,15 @@
''' 继续音乐播放,返回是否成功切换了状态。
''' </summary>
Public Function MusicResume() As Boolean
If MusicState = MusicStates.Pause Then
If MusicState = MusicStates.Play Then
Return False
Else
RunInThread(Sub()
MusicNAudio.Play()
MusicRefreshUI()
Log("[Music] 已恢复播放")
End Sub)
Return True
Else
Return False
End If
End Function