Option Explicit
' 配置区域
Const APP_NAME = "notepad.exe" ' 要监控的进程名
Const APP_PATH = "C:\Windows\notepad.exe" ' 应用程序完整路径
Const CHECK_INTERVAL = 5000 ' 检查间隔（毫秒）
Const LOG_FILE = "C:\MonitorLog.txt" ' 日志文件路径
Dim fso, shell, wmiService
Set fso = CreateObject("Scripting.FileSystemObject")
Set shell = CreateObject("WScript.Shell")
Set wmiService = GetObject("winmgmts:\\.\root\cimv2")
' 日志函数
Sub WriteLog(message)
Dim logStream
Set logStream = fso.OpenTextFile(LOG_FILE, 8, True) ' 8 = 追加模式
logStream.WriteLine Now & " - " & message
logStream.Close
End Sub
' 检查进程是否存在
Function IsProcessRunning(processName)
Dim processes
On Error Resume Next
Set processes = wmiService.ExecQuery("SELECT * FROM Win32_Process WHERE Name='" & processName & "'")
IsProcessRunning = (processes.Count > 0)
On Error GoTo 0
End Function
' 启动应用程序
Sub StartApplication()
Dim result
On Error Resume Next
' 检查文件是否存在
If Not fso.FileExists(APP_PATH) Then
WriteLog "错误: 应用程序不存在 - " & APP_PATH
Exit Sub
End If
' 启动应用程序
result = shell.Run(APP_PATH, 1, False) ' 1=普通窗口, False=异步执行
If Err.Number = 0 Then
WriteLog "已启动: " & APP_NAME & " (" & APP_PATH & ")"
Else
WriteLog "启动失败: " & APP_NAME & " - 错误: " & Err.Description
End If
On Error GoTo 0
End Sub
' 主监控循环
Sub MonitorApp()
WriteLog "监控开始 - 目标进程: " & APP_NAME
Do
If Not IsProcessRunning(APP_NAME) Then
WriteLog "检测到 " & APP_NAME & " 未运行"
StartApplication
End If
' 等待下一次检查
WScript.Sleep CHECK_INTERVAL
Loop
End Sub
' 启动监控
MonitorAppOption Explicit
' ============ 配置区域 ============
' 要监控的应用程序列表（可以监控多个应用）
Dim apps(2) ' 定义数组大小
Set apps(0) = CreateApp("notepad.exe", "C:\Windows\notepad.exe")
Set apps(1) = CreateApp("calc.exe", "C:\Windows\System32\calc.exe")
' 可以继续添加...
' 监控设置
Const CHECK_INTERVAL = 10000 ' 检查间隔（10秒）
Const MAX_RESTART_ATTEMPTS = 3 ' 最大重启尝试次数
Const LOG_FILE = "C:\Logs\AppMonitor.log"
Const ERROR_LOG_FILE = "C:\Logs\AppMonitor_Error.log"
' ============ 初始化 ============
Dim fso, shell, wmiService, restartCount
Set fso = CreateObject("Scripting.FileSystemObject")
Set shell = CreateObject("WScript.Shell")
Set wmiService = GetObject("winmgmts:\\.\root\cimv2")
restartCount = 0
' ============ 辅助函数 ============
' 创建应用程序对象
Function CreateApp(name, path)
Dim app
Set app = CreateObject("Scripting.Dictionary")
app.Add "Name", name
app.Add "Path", path
app.Add "IsRunning", False
app.Add "StartTime", Null
Set CreateApp = app
End Function
' 创建日志目录
Sub CreateLogDirectory(logPath)
Dim folderPath
folderPath = fso.GetParentFolderName(logPath)
If Not fso.FolderExists(folderPath) Then
On Error Resume Next
fso.CreateFolder folderPath
On Error GoTo 0
End If
End Sub
' 日志函数
Sub WriteLog(message, isError)
Dim logStream, logPath
If isError Then
logPath = ERROR_LOG_FILE
Else
logPath = LOG_FILE
End If
CreateLogDirectory logPath
On Error Resume Next
Set logStream = fso.OpenTextFile(logPath, 8, True)
logStream.WriteLine Now & " - " & message
logStream.Close
On Error GoTo 0
' 控制台输出（调试用）
WScript.Echo Now & " - " & message
End Sub
' ============ 核心功能 ============
' 检查进程是否存在
Function IsProcessRunning(processName)
Dim processes, process
On Error Resume Next
Set processes = wmiService.ExecQuery("SELECT * FROM Win32_Process WHERE Name='" & processName & "'")
' 详细检查
For Each process In processes
If UCase(process.Name) = UCase(processName) Then
IsProcessRunning = True
Exit Function
End If
Next
IsProcessRunning = False
On Error GoTo 0
End Function
' 启动应用程序
Function StartApplication(app)
Dim result, cmd, workingDir
On Error Resume Next
WriteLog "尝试启动: " & app("Name"), False
' 检查文件是否存在
If Not fso.FileExists(app("Path")) Then
WriteLog "错误: 应用程序不存在 - " & app("Path"), True
Exit Function
End If
' 设置工作目录
workingDir = fso.GetParentFolderName(app("Path"))
' 构建启动命令
cmd = Chr(34) & app("Path") & Chr(34) ' 用引号包裹路径
' 启动应用程序
result = shell.Run(cmd, 1, False, workingDir)
If Err.Number = 0 Then
WriteLog "成功启动: " & app("Name"), False
StartApplication = True
app("StartTime") = Now
app("IsRunning") = True
Else
WriteLog "启动失败: " & app("Name") & " - 错误: " & Err.Description, True
StartApplication = False
End If
On Error GoTo 0
End Function
' 强制结束进程
Sub KillProcess(processName)
Dim processes, process
On Error Resume Next
Set processes = wmiService.ExecQuery("SELECT * FROM Win32_Process WHERE Name='" & processName & "'")
For Each process In processes
process.Terminate()
If Err.Number = 0 Then
WriteLog "已终止进程: " & processName, False
End If
Next
On Error GoTo 0
End Sub
' ============ 主监控循环 ============
Sub MonitorApps()
Dim i, app, isAnyRunning
WriteLog "应用程序监控服务启动", False
WriteLog "监控间隔: " & (CHECK_INTERVAL/1000) & "秒", False
Do
isAnyRunning = False
' 检查每个应用
For i = 0 To UBound(apps)
Set app = apps(i)
If IsProcessRunning(app("Name")) Then
If Not app("IsRunning") Then
WriteLog "检测到运行: " & app("Name"), False
app("IsRunning") = True
End If
isAnyRunning = True
Else
If app("IsRunning") Then
WriteLog "检测到停止: " & app("Name"), False
app("IsRunning") = False
End If
' 尝试重启
If restartCount < MAX_RESTART_ATTEMPTS Then
If StartApplication(app) Then
restartCount = 0
Else
restartCount = restartCount + 1
WriteLog "重启尝试次数: " & restartCount & "/" & MAX_RESTART_ATTEMPTS, True
End If
Else
WriteLog "达到最大重启次数，停止尝试: " & app("Name"), True
End If
End If
Next
' 等待下一次检查
WScript.Sleep CHECK_INTERVAL
Loop
End Sub
' ============ 启动脚本 ============
' 检查是否以管理员权限运行（可选）
If Not IsElevated() Then
WriteLog "警告: 建议以管理员权限运行此脚本", True
End If
' 创建日志目录
CreateLogDirectory LOG_FILE
CreateLogDirectory ERROR_LOG_FILE
' 开始监控
On Error Resume Next
MonitorApps
If Err.Number <> 0 Then
WriteLog "监控服务异常停止: " & Err.Description, True
WScript.Quit 1
End If创建一个批处理文件 SetupMonitor.bat：
@echo off
echo 创建应用程序监控任务...
:: 创建计划任务（每5分钟运行一次）
schtasks /create /tn "Application Monitor" /tr "wscript.exe C:\Scripts\AppMonitor.vbs" /sc minute /mo 5 /ru SYSTEM /rl HIGHEST /f
:: 立即启动一次
schtasks /run /tn "Application Monitor"
echo 监控任务已创建！
pause创建一个停止脚本 StopMonitor.vbs：
Option Explicit
' 停止所有监控进程
Dim wmiService, processes, process
Set wmiService = GetObject("winmgmts:\\.\root\cimv2")
Set processes = wmiService.ExecQuery("SELECT * FROM Win32_Process WHERE Name='wscript.exe'")
For Each process In processes
If InStr(process.CommandLine, "AppMonitor.vbs") > 0 Then
process.Terminate()
WScript.Echo "已停止监控进程: PID " & process.ProcessId
End If
Next
' 删除计划任务
Dim shell
Set shell = CreateObject("WScript.Shell")
shell.Run "schtasks /delete /tn ""Application Monitor"" /f", 0, True
WScript.Echo "监控已停止"保存脚本：将基础脚本保存为 AppMonitor.vbs
修改配置：
APP_NAME 为要监控的进程名（如：myapp.exe）APP_PATH 为应用程序的完整路径CHECK_INTERVAL 检查间隔（毫秒）运行方式：
AppMonitor.vbs这个脚本会持续监控指定的应用程序，如果发现进程不存在，会自动重新启动它，并记录所有操作到日志文件中。
