Public Module ModWatcher '对全体的监视 Public McWatcherList As New List(Of Watcher) Private IsWatcherRunning As Boolean = False Public HasRunningMinecraft As Boolean = False Private Sub WatcherStateChanged() Dim IsRunning As Boolean = False Dim TriggerLauncherShutdown As Boolean = True For Each Watcher In McWatcherList If Watcher.State = Watcher.MinecraftState.Loading OrElse Watcher.State = Watcher.MinecraftState.Running Then IsRunning = True Exit For ElseIf Watcher.State = Watcher.MinecraftState.Crashed OrElse Watcher.State = Watcher.MinecraftState.Canceled Then TriggerLauncherShutdown = False End If Next If IsWatcherRunning = IsRunning Then Return IsWatcherRunning = IsRunning If IsWatcherRunning Then MinecraftStart() Else MinecraftStop(TriggerLauncherShutdown) End If End Sub Private Sub MinecraftStart() McLaunchLog("[全局] 出现运行中的 Minecraft") HasRunningMinecraft = True FrmMain.BtnExtraShutdown.ShowRefresh() End Sub Private Sub MinecraftStop(TriggerLauncherShutdown As Boolean) McLaunchLog("[全局] 已无运行中的 Minecraft") HasRunningMinecraft = False FrmMain.BtnExtraShutdown.ShowRefresh() '音乐播放 If Settings.Get(Of Boolean)("UiMusicStop") Then RunInUi(Sub() If MusicResume() Then Logger.Info("已根据设置,在结束后开始音乐播放")) ElseIf Settings.Get(Of Boolean)("UiMusicStart") Then RunInUi(Sub() If MusicPause() Then Logger.Info("已根据设置,在结束后暂停音乐播放")) End If '启动器可见性 Select Case Settings.Get(Of Integer)("LaunchArgumentVisible") Case 2 '直接关闭 If TriggerLauncherShutdown Then RunInUi(Sub() FrmMain.EndProgram(False)) Else RunInUi(Sub() FrmMain.Hidden = False) End If Case 3 '恢复 RunInUi(Sub() FrmMain.Hidden = False) End Select End Sub '对单个进程的监视 Public Class Watcher '初始化 Public GameProcess As Process Public Instance As McInstance Private WindowTitle As String = "" Private PID As Integer Public Loader As LoaderTask(Of Process, Integer) Public Sub New(Loader As LoaderTask(Of Process, Integer), Instance As McInstance, WindowTitle As String) Me.Loader = Loader Me.Instance = Instance Me.WindowTitle = WindowTitle Me.PID = Loader.Input.Id WatcherLog("开始 Minecraft 日志监控") If Me.WindowTitle <> "" Then WatcherLog("要求窗口标题:" & WindowTitle) '更改列表 Dim NewWatcherList As New List(Of Watcher) For Each Watch In McWatcherList If Watch.State = MinecraftState.Crashed OrElse Watch.State = MinecraftState.Ended OrElse Watch.State = MinecraftState.Canceled Then Continue For NewWatcherList.Add(Watch) Next NewWatcherList.Add(Me) McWatcherList = NewWatcherList WatcherStateChanged() '初始化进程与日志读取 GameProcess = Loader.Input GameProcess.BeginOutputReadLine() GameProcess.BeginErrorReadLine() AddHandler GameProcess.OutputDataReceived, AddressOf LogReceived 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.Interrupted 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 Logger.Error(ex, "Minecraft 日志监控主循环出错") State = MinecraftState.Ended End Try End Sub, "Minecraft Watcher PID " & PID) End Sub '状态 Private _State As MinecraftState = MinecraftState.Loading Public Property State As MinecraftState Get Return _State End Get Set(value As MinecraftState) If _State = value Then Return _State = value WatcherStateChanged() End Set End Property Public Enum MinecraftState Loading Running Crashed Ended Canceled End Enum '日志 Public WaitingLog As New List(Of String)(1000) Private ReadOnly WaitingLogLock As New Object Private Sub LogReceived(sender As Object, e As DataReceivedEventArgs) SyncLock WaitingLogLock WaitingLog.Add(e.Data) End SyncLock End Sub Private Sub TimerLog() Try '输出文本 Dim Copyed As New List(Of String) SyncLock WaitingLogLock If Not WaitingLog.Any() Then Return Copyed = WaitingLog WaitingLog = New List(Of String)(1000) End SyncLock For Each Str As String In Copyed GameLog(Str) Next If State = MinecraftState.Loading Then ProgressUpdate() '游戏退出检查 If GameProcess.HasExited Then WatcherLog("Minecraft 已退出,返回值:" & GameProcess.ExitCode) 'If Process.ExitCode = 1 Then ' '返回值为 1,考虑是任务管理器结束 ' WatcherLog("Minecraft 返回值为 1,考虑为任务管理器结束") '并不,崩了照样是 1 ' State = MinecraftState.Ended 'Else If State = MinecraftState.Loading Then '窗口未出现 WatcherLog("Minecraft 尚未加载完成,可能已崩溃", LogLevel.Error) Crashed() ElseIf GameProcess.ExitCode <> 0 AndAlso State = MinecraftState.Running AndAlso Instance.ReleaseTime.Year >= 2012 Then '返回值不为 0 且未结束 WatcherLog("Minecraft 返回值异常,可能已崩溃", LogLevel.Error) Crashed() ElseIf State <> MinecraftState.Crashed Then '正常关闭 State = MinecraftState.Ended End If End If Catch ex As Exception Logger.Error(ex, "输出 Minecraft 日志失败") End Try End Sub Public LatestLog As New Queue(Of String) Private Sub GameLog(Text As String) '预处理 If Text Is Nothing Then Return Text = Text.ReplaceLineEndings(vbCrLf) 'If Text.Contains("�����") Then Hint("检测到错误的日志编码:" & Text) '加入预存储 LatestLog.Enqueue(Text) If LatestLog.Count >= 501 Then LatestLog.Dequeue() Logger.Trace(Text) '进度处理 If LogProgress < 1 Then WatcherLog("日志 1/5:已出现日志输出") LogProgress = 1 End If '可能第一句就是后面需要判断的 Log(重现:启动 1.15.2 原版) If LogProgress < 2 AndAlso Text.Contains("Setting user:") Then WatcherLog("日志 2/5:游戏用户已设置") '仅确保支持 Minecraft 1.7+ LogProgress = 2 ElseIf LogProgress < 3 AndAlso Text.ContainsIgnoreCase("lwjgl version") Then WatcherLog("日志 3/5:LWJGL 版本已确认") LogProgress = 3 ElseIf LogProgress < 4 AndAlso (Text.Contains("OpenAL initialized") OrElse Text.Contains("Starting up SoundSystem")) Then WatcherLog("日志 4/5:OpenAL 已加载") '仅确保支持 Minecraft 1.7+ LogProgress = 4 ElseIf LogProgress < 5 AndAlso ((Text.Contains("Created") AndAlso Text.Contains("textures") AndAlso Text.Contains("-atlas")) OrElse Text.Contains("Found animation info")) Then WatcherLog("日志 5/5:材质已加载") '仅确保支持 Minecraft 1.7+ LogProgress = 5 End If '输出日志 'Log(Text) '关闭与崩溃检测 If Not Text.Contains("[CHAT]") Then If Text.Contains("Someone is closing me!") OrElse Text.Contains("Restarting Minecraft with command") Then '#1258 WatcherLog("识别为关闭的 Log:" & Text) State = MinecraftState.Ended ElseIf Text.Contains("Crash report saved to") OrElse Text.Contains("This crash report has been saved to:") Then ' Text.Contains("Minecraft ran into a problem! Report saved to:") Then 'Minecraft 崩溃,忽略 VanillaFix WatcherLog("识别为崩溃的 Log:" & Text, LogLevel.Error) Crashed() ElseIf Text.Contains("Could not save crash report to") Then 'Minecraft 崩溃,无法保存崩溃日志 WatcherLog("识别为崩溃的 Log:" & Text, LogLevel.Error) Crashed() ElseIf Text.Contains("/ERROR]: Unable to launch") OrElse Text.Contains("An exception was thrown, the game will display an error screen and halt.") Then 'Forge 崩溃 WatcherLog("识别为崩溃的 Log:" & Text, LogLevel.Error) Crashed() 'ElseIf Text.Contains("Shutdown failure!") Then ' 'Minecraft 强行崩溃,由于点 X 强行关闭也会触发这句话,所以不可用 ' Crashed(Nothing) End If End If End Sub Private Sub WatcherLog(Text As String, Optional Level As LogLevel = LogLevel.Info) McLaunchLog("[" & PID & "] " & Text, Level) End Sub '进度更新 Private LogProgress As Integer = 0 Private Sub ProgressUpdate() Dim CurrentProgress As Double If IsWindowAppeared OrElse LogProgress = 5 Then CurrentProgress = 0.95 WatcherLog("Minecraft 加载已完成") State = MinecraftState.Running Else CurrentProgress = Math.Min(LogProgress, 3) / 3 * 0.9 End If Loader.Progress = CurrentProgress End Sub '窗口检查 Private IsWindowAppeared As Boolean = False ''' ''' 窗口检查是否已经完成。这不一定代表着找到了窗口(如果没有找到,IsWindowAppeared 仍为 False)。 ''' Private IsWindowFinished As Boolean = False Private WindowHandle As IntPtr Private Sub TimerWindow() Try If GameProcess.HasExited Then Return If IsWindowFinished Then Return '获取全部窗口,检查是否有新增的 Dim MinecraftWindow As KeyValuePair(Of IntPtr, String)? = Nothing Try MinecraftWindow = TryGetMinecraftWindow() Catch ex As ComponentModel.Win32Exception '拒绝访问(#1062) Logger.Error(ex, "由于反作弊或安全软件拦截,PCL 无法操作游戏窗口", LogBehavior.Toast) IsWindowFinished = True End Try If MinecraftWindow Is Nothing Then Return Dim MinecraftWindowName = MinecraftWindow.Value.Value, MinecraftWindowHandle = MinecraftWindow.Value.Key '已找到窗口 If Not MinecraftWindowName.StartsWithF("FML") AndAlso Not MinecraftWindowName.StartsWithF("Quilt Loader") Then '已找到 Minecraft 窗口 WindowHandle = MinecraftWindowHandle WatcherLog($"Minecraft 窗口已加载:{MinecraftWindowName}({MinecraftWindowHandle.ToInt64})") IsWindowFinished = True '最大化 If Settings.Get(Of Integer)("LaunchArgumentWindowType") = 4 Then RunInNewThread( Sub() Try '如果最大化导致屏幕渲染大小不对,那是 MC 的 Bug,不是我的 Bug '……虽然我很想这样说,但总有人反馈,算了 Thread.Sleep(2000) ShowWindow(WindowHandle, 3) WatcherLog($"已最大化 Minecraft 窗口:{MinecraftWindowHandle.ToInt64}") Catch ex As Exception Logger.Warn(ex, "最大化 Minecraft 窗口时出现错误") End Try End Sub, "MinecraftWindowMaximize") End If ElseIf Not IsWindowAppeared Then '已找到 Mod Loader 窗口 WatcherLog("Mod Loader 窗口已加载:" & MinecraftWindowName & "(" & MinecraftWindowHandle.ToInt64 & ")") End If IsWindowAppeared = True Catch ex As Exception Logger.Error(ex, "检查 Minecraft 窗口失败") End Try End Sub ''' ''' 获取可能是当前进程对应的 Minecraft 窗口的句柄和标题。 ''' Nothing 代表未找到。 ''' Private Function TryGetMinecraftWindow() As KeyValuePair(Of IntPtr, String)? Dim Result = Nothing EnumWindows( Sub(hwnd As IntPtr, lParam As Integer) If Result IsNot Nothing Then Return '检查类名 Dim str As New StringBuilder(512) GetClassName(hwnd, str, str.Capacity) Dim ClassName As String = str.ToString If Not (ClassName = "GLFW30" OrElse ClassName = "LWJGL" OrElse ClassName = "SunAwtFrame") Then Return '获取窗口标题名 str = New StringBuilder(512) GetWindowText(hwnd, str, str.Capacity) Dim WindowText As String = str.ToString '有的 Mod 可以修改窗口标题,所以不能检测是否为 Minecraft 打头,这并不准确 '部分版本会搞个 GLFW message window 出来所以得反选 If Not (WindowText.StartsWithF("FML") OrElse (WindowText <> "PopupMessageWindow") AndAlso Not WindowText.StartsWithF("GLFW")) Then Return '获取窗口关联的进程 Dim ProcessId As Integer GetWindowThreadProcessId(hwnd, ProcessId) Try If Process.GetProcessById(ProcessId).StartTime < GameProcess.StartTime Then Return '需要是此后启动的进程 Catch ex As Exception Logger.Warn(ex, "枚举 Minecraft 窗口进程失败") Return End Try '返回 Result = New KeyValuePair(Of IntPtr, String)(hwnd, WindowText) End Sub, 0) Return Result End Function Private Delegate Sub EnumWindowsSub(hwnd As IntPtr, lParam As Integer) Private Declare Function EnumWindows Lib "user32" (hWnd As EnumWindowsSub, lParam As Integer) As Boolean Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (hWnd As Integer, str As StringBuilder, maxCount As Integer) As Integer Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (hWnd As Integer, str As StringBuilder, maxCount As Integer) As Integer Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (hWnd As Integer, str As String) As Boolean Private Declare Function ShowWindow Lib "user32" (hWnd As IntPtr, cmdWindow As UInteger) As Boolean Private Declare Function GetWindowThreadProcessId Lib "user32" (hWnd As IntPtr, ByRef lpdwProcessId As Integer) As Integer '崩溃处理 Private Sub Crashed() If State = MinecraftState.Crashed OrElse State = MinecraftState.Ended Then Return State = MinecraftState.Crashed '崩溃分析 WatcherLog("Minecraft 已崩溃,将在 2 秒后开始崩溃分析", LogLevel.Error) Hint("检测到 Minecraft 出现错误,错误分析已开始……", HintType.Red) FeedbackInfo() RunInNewThread( Sub() Try Thread.Sleep(2000) WatcherLog("崩溃分析开始") Dim Analyzer As New CrashAnalyzer(Instance) Analyzer.Collect(Instance.PathIndie, LatestLog.ToList) Analyzer.Prepare() Analyzer.Analyze() Analyzer.Output(False, New List(Of String) From {Instance.PathVersion & Instance.Name & ".json", PathExeFolder & "PCL\Log1.txt", PathExeFolder & "PCL\LatestLaunch.bat"}) Catch ex As Exception Logger.Error(ex, "崩溃分析失败") End Try End Sub, "Crash Analyzer") End Sub '强制关闭 Public Sub Kill() State = MinecraftState.Canceled WatcherLog("尝试强制结束 Minecraft 进程") Try If Not GameProcess.HasExited Then GameProcess.Kill() WatcherLog("已强制结束 Minecraft 进程") Catch ex As Exception Logger.Error(ex, "强制结束 Minecraft 进程失败", LogBehavior.Toast) End Try End Sub End Class End Module