用vb编写简单的守护程序

做了部分修改和优化，版权归原作者所有
1，如果你仅仅想监视一个目标，那么WaitForSingleObject是非常好的。
内存占用惊人！
Option Explicit
Private Declare Function FindWindow Lib “user32” Alias “FindWindowA” (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetClassName Lib “user32” Alias “GetClassNameA” (ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) _
As Long
Private Declare Function GetSystemDirectory Lib “kernel32” Alias “GetSystemDirectoryA” (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Const Max_Path = 260
Private Declare Function OpenProcess Lib “kernel32” (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long
Private Declare Function WaitForSingleObject Lib “kernel32” (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib “kernel32” (ByVal hObject As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib “user32” (ByVal hwnd As Long, _
lpdwProcessId As Long) As Long
Const SYNCHRONIZE = &H100000
Const INFINITE = -1&
Dim TempDir As String
Private Sub Form_Load()
On Error Resume Next
Dim I As Long
Dim r As Long
Dim p As Long
Dim lngHand As Long
Dim strName As String * 255
Dim lngProcID As Long
Dim IngName As String
If App.PrevInstance Then End
App.TaskVisible = False
TempDir = GetWinSysDir & “\fff.exe”
IngName = “asdf” ‘被监视程序fff.exe窗体的caption，fff.exe的这里换成本程序的caption就OK
lngHand = FindWindow(vbNullString, IngName)
GetClassName lngHand, strName, Len(strName)
If Left$(strName, 1) = vbNullChar Then
If Not Dir(TempDir$, 7) = “” Then
GetWindowThreadProcessId lngHand, lngProcID
End If
I = lngProcID
p = OpenProcess(SYNCHRONIZE, False, I)
r = WaitForSingleObject(p, INFINITE)
r = CloseHandle(p)
Else
If Not Dir(TempDir$, 7) = “” Then
Shell TempDir, vbHide
End If
End If
End Sub
Public Function GetWinSysDir()
Dim S As String, Length As Long
S = String(Max_Path, 0)
Length = GetSystemDirectory(S, Max_Path)
S = Left(S, InStr(S, Chr(0)) – 1)
GetWinSysDir = S
End Function
2，如果一个程序要监视2个目标，WaitForSingleObject就不是很好，因为它总是在等待着，也就是说程序执行到WaitForSingleObject时就不往下执行了，直到CloseHandle。这时可用timer。
Option Explicit
Private Declare Function FindWindow Lib “user32” Alias “FindWindowA” (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetClassName Lib “user32” Alias “GetClassNameA” (ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) _
As Long
Private Declare Function GetSystemDirectory Lib “kernel32” Alias “GetSystemDirectoryA” (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Const Max_Path = 260
Dim TempDir As String
Private Sub Timer1_Timer()
On Error Resume Next
Dim lngHand As Long
Dim strName As String * 255
Dim lngProcID As Long
Dim IngName As String
TempDir = GetWinSysDir & “\fff.exe”
IngName = “asdf” ‘被监视程序fff.exe窗体的caption，fff.exe的这里换成本程序的caption就OK
lngHand = FindWindow(vbNullString, IngName)
GetClassName lngHand, strName, Len(strName)
If Left$(strName, 1) = vbNullChar Then
If Not Dir(TempDir$, 7) = “” Then
Shell TempDir, vbHide
End If
End If
End Sub
Public Function GetWinSysDir()
Dim S As String, Length As Long
S = String(Max_Path, 0)
Length = GetSystemDirectory(S, Max_Path)
S = Left(S, InStr(S, Chr(0)) – 1)
GetWinSysDir = S
End Function
Private Sub Form_Load()
On Error Resume Next
If App.PrevInstance Then End
App.TaskVisible = False
End Sub