Merge pull request #10 from Hex-Dragon/main

111

Plain Craft Launcher 2/Modules/Base/ModBase.vb

@@ -838,16 +838,16 @@ Public Module ModBase
         '确保目录存在
         Directory.CreateDirectory(GetPathFromFullPath(FilePath))
         '写入文件
-        If File.Exists(FilePath) Then
-            '如果文件存在，刷新目前文件
-            Using writer As New StreamWriter(FilePath, Append, If(Encoding, GetEncoding(ReadFileBytes(FilePath))))
+        If Append Then
+            '追加目前文件
+            Using writer As New StreamWriter(FilePath, True, If(Encoding, GetEncoding(ReadFileBytes(FilePath))))
                 writer.Write(Text)
                 writer.Flush()
                 writer.Close()
             End Using
         Else
-            '如果文件不存在，则新建并写入
-            File.WriteAllText(FilePath, Text, If(Encoding, New UTF8Encoding(False)))
+            '直接写入字节集
+            File.WriteAllBytes(FilePath, If(Encoding Is Nothing, Encoding.UTF8.GetBytes(Text), Encoding.GetBytes(Text)))
         End If
     End Sub
     ''' <summary>

Plain Craft Launcher 2/Modules/Minecraft/ModLaunch.vb

@@ -128,6 +128,10 @@ Public Module ModLaunch
                     Loaders.Insert(3, New LoaderTask(Of Integer, Integer)("内存优化", AddressOf McLaunchMemoryOptimize) With {.ProgressWeight = 30})
                 Case 2 '关闭
             End Select
+            '显示设置
+            If Setup.Get("LaunchGraphicSetup") Then
+                Loaders.Insert(3, New LoaderTask(Of Integer, Integer)("检查显示设置", AddressOf McLaunchCheckGraphicSettings) With {.ProgressWeight = 2})
+            End If
             Dim LaunchLoader As New LoaderCombo(Of Object)("Minecraft 启动", Loaders) With {.Show = False}
             If McLoginLoader.State = LoadState.Finished Then McLoginLoader.State = LoadState.Waiting '要求重启登录主加载器，它会自行决定是否启动副加载器
             '等待加载器执行并更新 UI
@@ -203,6 +207,48 @@ NextInner:
 
 #End Region
 
+#Region "显示设置"
+
+    Private Sub McLaunchCheckGraphicSettings(Loader As LoaderTask(Of Integer, Integer))
+        Const GPU_KEY As String = "Software\Microsoft\DirectX\UserGpuPreferences"
+        Const TARGET_SETUP As String = "GpuPreference=2;"
+        Dim javaPath As String = McLaunchJavaSelected.PathJavaw
+
+        McLaunchLog("显示设置开始")
+        '读取现行设置
+        Try
+            Dim parentKey As Microsoft.Win32.RegistryKey = My.Computer.Registry.CurrentUser
+            Dim regKey As Microsoft.Win32.RegistryKey = parentKey.OpenSubKey(GPU_KEY, False)
+            If regKey IsNot Nothing Then
+                Dim currentSetting As Object = regKey.GetValue(javaPath)
+                If currentSetting IsNot Nothing And TARGET_SETUP.Equals(currentSetting.ToString()) Then
+                    McLaunchLog("不需要调整显示设置")
+                    Exit Sub
+                End If
+                regKey.Close()
+            End If
+        Catch ex As Exception
+            McLaunchLog("无法读取注册表，跳过显示设置")
+            Exit Sub
+        End Try
+        '更新设置
+        Try
+            If Not IsAdmin() Then RunAsAdmin("")
+            Dim parentKey As Microsoft.Win32.RegistryKey = My.Computer.Registry.CurrentUser
+            Dim regKey As Microsoft.Win32.RegistryKey = parentKey.OpenSubKey(GPU_KEY, True)
+            If regKey Is Nothing Then
+                regKey = parentKey.CreateSubKey(GPU_KEY)
+            End If
+            regKey.SetValue(javaPath, TARGET_SETUP)
+        Catch ex As Exception
+            McLaunchLog("无法写入显示设置")
+            Exit Sub
+        End Try
+        McLaunchLog("已修改显示设置")
+    End Sub
+
+#End Region
+
 #Region "预检测"
 
     Private Sub McLaunchPrecheck()
@@ -1317,14 +1363,15 @@ Retry:
         McLaunchLog("开始获取 Minecraft 启动参数")
         '获取基准字符串与参数信息
         Dim Arguments As String
+        Arguments = If(McLaunchJavaSelected.VersionCode > 8, "-Dfile.encoding=UTF-8 -Dstdout.encoding=UTF-8 -Dstderr.encoding=UTF-8 ", Nothing) '#4700
         If McVersionCurrent.JsonObject("arguments") IsNot Nothing AndAlso McVersionCurrent.JsonObject("arguments")("jvm") IsNot Nothing Then
             McLaunchLog("获取新版 JVM 参数")
-            Arguments = McLaunchArgumentsJvmNew(McVersionCurrent)
+            Arguments += McLaunchArgumentsJvmNew(McVersionCurrent)
             McLaunchLog("新版 JVM 参数获取成功：")
             McLaunchLog(Arguments)
         Else
             McLaunchLog("获取旧版 JVM 参数")
-            Arguments = McLaunchArgumentsJvmOld(McVersionCurrent)
+            Arguments += McLaunchArgumentsJvmOld(McVersionCurrent)
             McLaunchLog("旧版 JVM 参数获取成功：")
             McLaunchLog(Arguments)
         End If
@@ -1421,9 +1468,10 @@ Retry:
 
         '添加 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=""" & PathPure.TrimEnd("\") & """")
-        DataList.Add("-jar """ & ExtractJavaWrapper() & """")
-
+        If Setup.Get("VersionAdvanceUseLaunchWrapperV2", Version) AndAlso Setup.Get("LaunchAdvanceUseLaunchWrapper") Then
+            DataList.Add("-Doolloo.jlw.tmpdir=""" & PathPure.TrimEnd("\") & """")
+            DataList.Add("-jar """ & ExtractJavaWrapper() & """")
+        End If
         '添加 MainClass
         If Version.JsonObject("mainClass") Is Nothing Then
             Throw New Exception("版本 json 中没有 mainClass 项！")
@@ -1488,9 +1536,10 @@ 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=""" & PathPure.TrimEnd("\") & """")
-        DataList.Add("-jar """ & ExtractJavaWrapper() & """")
-
+        If Setup.Get("VersionAdvanceUseLaunchWrapperV2", Version) AndAlso Setup.Get("LaunchAdvanceUseLaunchWrapper") Then
+            DataList.Add("-Doolloo.jlw.tmpdir=""" & PathPure.TrimEnd("\") & """")
+            DataList.Add("-jar """ & ExtractJavaWrapper() & """")
+        End If
         '将 "-XXX" 与后面 "XXX" 合并到一起
         '如果不合并，会导致 Forge 1.17 启动无效，它有两个 --add-exports，进一步导致其中一个在后面被去重
         Dim DeDuplicateDataList As New List(Of String)
@@ -2050,6 +2099,7 @@ IgnoreCustomSkin:
         '输出 bat
         Try
             Dim CmdString As String =
+                $"{If(McLaunchJavaSelected.VersionCode > 8, "chcp 65001>nul" & vbCrLf, Nothing)}" &
                 "@echo off" & vbCrLf &
                 "title 启动 - " & McVersionCurrent.Name & vbCrLf &
                 "echo 游戏正在启动，请稍候。" & vbCrLf &
@@ -2142,8 +2192,8 @@ IgnoreCustomSkin:
         StartInfo.EnvironmentVariables("Path") = Join(Paths.Distinct.ToList, ";")
 
         '设置其他参数
-        StartInfo.StandardErrorEncoding = Encoding.UTF8
-        StartInfo.StandardOutputEncoding = Encoding.UTF8
+        StartInfo.StandardErrorEncoding = If(McLaunchJavaSelected.VersionCode > 8, Encoding.UTF8, Nothing)
+        StartInfo.StandardOutputEncoding = If(McLaunchJavaSelected.VersionCode > 8, Encoding.UTF8, Nothing)
         StartInfo.WorkingDirectory = ShortenPath(McVersionCurrent.PathIndie)
         StartInfo.UseShellExecute = False
         StartInfo.RedirectStandardOutput = True

Plain Craft Launcher 2/Modules/ModMusic.vb

@@ -1,4 +1,7 @@
-Public Module ModMusic
+Imports NAudio.CoreAudioApi
+Imports NAudio.CoreAudioApi.Interfaces
+
+Public Module ModMusic
 
 #Region "播放列表"
 
@@ -66,44 +69,44 @@
     ''' </summary>
     Private Sub MusicRefreshUI()
         RunInUi(
-        Sub()
-            Try
+            Sub()
+                Try
 
-                If Not MusicAllList.Any() Then
-                    '无背景音乐
-                    FrmMain.BtnExtraMusic.Show = False
-                Else
-                    '有背景音乐
-                    FrmMain.BtnExtraMusic.Show = True
-                    Dim ToolTipText As String
-                    If MusicState = MusicStates.Pause Then
-                        FrmMain.BtnExtraMusic.Logo = Logo.IconPlay
-                        FrmMain.BtnExtraMusic.LogoScale = 0.8
-                        ToolTipText = "已暂停：" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
-                        If MusicAllList.Count > 1 Then
-                            ToolTipText += vbCrLf & "左键恢复播放，右键播放下一曲。"
-                        Else
-                            ToolTipText += vbCrLf & "左键恢复播放，右键重新从头播放。"
-                        End If
+                    If Not MusicAllList.Any() Then
+                        '无背景音乐
+                        FrmMain.BtnExtraMusic.Show = False
                     Else
-                        FrmMain.BtnExtraMusic.Logo = Logo.IconMusic
-                        FrmMain.BtnExtraMusic.LogoScale = 1
-                        ToolTipText = "正在播放：" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
-                        If MusicAllList.Count > 1 Then
-                            ToolTipText += vbCrLf & "左键暂停，右键播放下一曲。"
+                        '有背景音乐
+                        FrmMain.BtnExtraMusic.Show = True
+                        Dim ToolTipText As String
+                        If MusicState = MusicStates.Pause Then
+                            FrmMain.BtnExtraMusic.Logo = Logo.IconPlay
+                            FrmMain.BtnExtraMusic.LogoScale = 0.8
+                            ToolTipText = "已暂停：" & GetFileNameWithoutExtentionFromPath(MusicCurrent)
+                            If MusicAllList.Count > 1 Then
+                                ToolTipText += vbCrLf & "左键恢复播放，右键播放下一曲。"
+                            Else
+                                ToolTipText += vbCrLf & "左键恢复播放，右键重新从头播放。"
+                            End If
                         Else
-                            ToolTipText += vbCrLf & "左键暂停，右键重新从头播放。"
+                            FrmMain.BtnExtraMusic.Logo = Logo.IconMusic
+                            FrmMain.BtnExtraMusic.LogoScale = 1
+                            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))
                     End If
-                    FrmMain.BtnExtraMusic.ToolTip = ToolTipText
-                    ToolTipService.SetVerticalOffset(FrmMain.BtnExtraMusic, If(ToolTipText.Contains(vbLf), 10, 16))
-                End If
-                If FrmSetupUI IsNot Nothing Then FrmSetupUI.MusicRefreshUI()
+                    If FrmSetupUI IsNot Nothing Then FrmSetupUI.MusicRefreshUI()
 
-            Catch ex As Exception
-                Log(ex, "刷新背景音乐 UI 失败", LogLevel.Feedback)
-            End Try
-        End Sub)
+                Catch ex As Exception
+                    Log(ex, "刷新背景音乐 UI 失败", LogLevel.Feedback)
+                End Try
+            End Sub)
     End Sub
 
     ''' <summary>
@@ -223,11 +226,11 @@
     Public Function MusicPause() As Boolean
         If MusicState = MusicStates.Play Then
             RunInThread(
-            Sub()
-                Log("[Music] 已暂停播放")
-                MusicNAudio?.Pause()
-                MusicRefreshUI()
-            End Sub)
+                Sub()
+                    Log("[Music] 已暂停播放")
+                    MusicNAudio?.Pause()
+                    MusicRefreshUI()
+                End Sub)
             Return True
         Else
             Log($"[Music] 无需暂停播放，当前状态为 {MusicState}")
@@ -243,11 +246,11 @@
             Return False
         Else
             RunInThread(
-            Sub()
-                Log("[Music] 已恢复播放")
-                MusicNAudio?.Play()
-                MusicRefreshUI()
-            End Sub)
+                Sub()
+                    Log("[Music] 已恢复播放")
+                    MusicNAudio?.Play()
+                    MusicRefreshUI()
+                End Sub)
             Return True
         End If
     End Function
@@ -255,7 +258,7 @@
 #End Region
 
     ''' <summary>
-    ''' 当前正在播放的 NAudio.Wave.WaveOut。
+    ''' 当前正在播放的 NAudio.Wave.WaveOutEvent。
     ''' </summary>
     Public MusicNAudio = Nothing
     ''' <summary>
@@ -267,12 +270,13 @@
     ''' 在 MusicUuid 不变的前提下，持续播放某地址的音乐，且在播放结束后随机播放下一曲。
     ''' </summary>
     Private Sub MusicLoop(Optional IsFirstLoad As Boolean = False)
-        Dim CurrentWave As NAudio.Wave.WaveOut = Nothing
+        Dim CurrentWave As NAudio.Wave.WaveOutEvent = Nothing
         Dim Reader As NAudio.Wave.WaveStream = Nothing
         Try
             '开始播放
-            CurrentWave = New NAudio.Wave.WaveOut()
+            CurrentWave = New NAudio.Wave.WaveOutEvent()
             MusicNAudio = CurrentWave
+            CurrentWave.DeviceNumber = -1
             Reader = New NAudio.Wave.AudioFileReader(MusicCurrent)
             CurrentWave.Init(Reader)
             CurrentWave.Play()
@@ -303,7 +307,7 @@
             If ex.Message.Contains("Got a frame at sample rate") OrElse ex.Message.Contains("does not support changes to") Then
                 Hint("播放音乐失败（" & GetFileNameFromPath(MusicCurrent) & "）：PCL 不支持播放音频属性在中途发生变化的音乐", HintType.Critical)
             ElseIf Not (MusicCurrent.EndsWithF(".wav", True) OrElse MusicCurrent.EndsWithF(".mp3", True) OrElse MusicCurrent.EndsWithF(".flac", True)) OrElse
-                ex.Message.Contains("0xC00D36C4") Then '#5096：不支持给定的 URL 的字节流类型。 (异常来自 HRESULT:0xC00D36C4)
+                    ex.Message.Contains("0xC00D36C4") Then '#5096：不支持给定的 URL 的字节流类型。 (异常来自 HRESULT:0xC00D36C4)
                 Hint("播放音乐失败（" & GetFileNameFromPath(MusicCurrent) & "）：PCL 可能不支持此音乐格式，请将格式转换为 .wav、.mp3 或 .flac 后再试", HintType.Critical)
             Else
                 Log(ex, "播放音乐失败（" & GetFileNameFromPath(MusicCurrent) & "）", LogLevel.Hint)