如何用VB实现判断某一程序的进程已经结束！

Question

我想实现实时判断某一程序的进程是否退出了，如果退出了则再次启动它！

Answer 1

请给一个例子，自动判断某一程序（例如MSN）的进程是否退出，如果退出了，则重新启动MSN

Answer 2

看，如果没有进程，启动即可
或者在循环进程的时候，与指定程序的进程相比较
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As LongPrivate Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _
    ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As LongPrivate Declare Function TerminateProcess Lib "kernel32" (ByVal ApphProcess As Long, _
    ByVal uExitCode As Long) As LongPrivate Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long
    th32DefaultHeapID As Long
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    dwFlags As Long
    szExeFile As String * 1024
End TypeConst TH32CS_SNAPHEAPLIST = &H1
Const TH32CS_SNAPPROCESS = &H2
Const TH32CS_SNAPTHREAD = &H4
Const TH32CS_SNAPMODULE = &H8
Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Const TH32CS_INHERIT = &H80000000Private Sub Command1_Click()
    If MsgBox("你想删除 " & ListView1.SelectedItem.SubItems(2) & " 进程?", vbYesNo + vbQuestion) <> vbYes Then
        Exit Sub
    End If
    
    Dim mProcID As Long
    mProcID = OpenProcess(1&, -1&, ListView1.SelectedItem)
    TerminateProcess mProcID, 0&
    DoEvents
    ListView1.ListItems.Remove (ListView1.SelectedItem.Index)
    ListView1.Refresh
End SubPrivate Sub CProcess_Click()
  Dim my As PROCESSENTRY32
  Dim l As Long
  Dim l1 As Long
  Dim mlistitem As ListItem
  
'  List1.Clear
  l = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
  If l Then
    my.dwSize = 1060
    If (Process32First(l, my)) Then '遍历第一个进程
      Do
       Set mlistitem = ListView1.ListItems.Add(, , my.th32ProcessID)
             mlistitem.SubItems(1) = my.th32ParentProcessID
             mlistitem.SubItems(2) = my.szExeFile
      Loop Until (Process32Next(l, my) < 1) '遍历所有进程知道返回值为False
    End If
    l1 = CloseHandle(l)
  End If
End SubPrivate Sub Form_Load()
    ListView1.ListItems.Clear
    ListView1.ColumnHeaders.Clear
    ListView1.FullRowSelect = True
    ListView1.ColumnHeaders.Add , , "Process ID", 1500
    ListView1.ColumnHeaders.Add , , "Process Parent ID", (1500)
    ListView1.ColumnHeaders.Add , , "Name", (Me.Width - 3200)
    ListView1.View = lvwReport
End Sub添加listview,两个按钮即可

Answer 3

楼上写的太复杂了，能不能简单些！就是直接判断MSN进程msnmsgr.exe是否启动就行了，在点击command1时，判断是否启动了msn进程，如果启动了，就提示进程已经启动，否则提示进程没有启动就行了。

Answer 4

省略api...
Dim pid As Long
Dim pname As StringPrivate Sub CProcess_Click()
  Dim my As PROCESSENTRY32
  Dim l As Long
  Dim l1 As Long  l = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
  If l Then
    my.dwSize = 1060
    If (Process32First(l, my)) Then '遍历第一个进程
      Do
        If my.szExeFile = "msnmsgr.exe" Then
             pid = my.th32ProcessID
             pname = my.szExeFile
             MsgBox "找到msn"
             Exit Sub
         Else
             MsgBox "没有找到msn"
             Shell "c:\mmmmmm\msn.exe"
             Exit Sub
         End If
      Loop Until (Process32Next(l, my) < 1) '遍历所有进程知道返回值为False
    End If
    l1 = CloseHandle(l)
  End If
End Sub

Answer 5

(龙卷风V2.0--再战江湖) ，你好，
不行啊，有些东西找不着，刚学vb，有些东西找不到阿！能不能帮写出详细代码和过程阿！

Answer 6

Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As LongPrivate Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long
    th32DefaultHeapID As Long
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    dwFlags As Long
    szExeFile As String * 1024
End TypeConst TH32CS_SNAPHEAPLIST = &H1
Const TH32CS_SNAPPROCESS = &H2
Const TH32CS_SNAPTHREAD = &H4
Const TH32CS_SNAPMODULE = &H8
Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Const TH32CS_INHERIT = &H80000000Dim pid As Long
Dim pname As StringPrivate Sub Command1_Click()
  Dim my As PROCESSENTRY32
  Dim l As Long
  Dim l1 As Long  l = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
  If l Then
    my.dwSize = 1060
    If (Process32First(l, my)) Then '遍历第一个进程
      Do
        If my.szExeFile = "msnmsgr.exe" Then
             pid = my.th32ProcessID
             pname = my.szExeFile
             MsgBox "找到msn"
             Exit Sub
         Else
             MsgBox "没有找到msn"
             Shell "c:\windows\notepad.exe", vbNormalFocus
             Exit Sub
         End If
      Loop Until (Process32Next(l, my) < 1) '遍历所有进程知道返回值为False
    End If
    l1 = CloseHandle(l)
  End If
End Sub添加一个按钮即可

Answer 7

很简单啊，这个问题和只允许运行一次的程序一样处理就可以了，
在这个程序启动的时候判断一下是否已经运行，如果没有，则运行，如果有则不运行。
在你的程序中加上
Form_Load()
If App.PrevInstance Then End '如果此程序已经有实例在运行则退出,如没有则继续运行
End Sub
然后只要用另一个程序每隔一段时间就启动一下这个程序,就可以了.

Answer 8

Private  Declare  Function  CreateToolhelp32Snapshot  Lib    "kernel32  "  (ByVal  dwFlags  As  Long,  ByVal  th32ProcessID  As  Long)  As  Long  
Private  Declare  Function  Process32First  Lib    "kernel32  "  (ByVal  hSnapshot  As  Long,  lppe  As  PROCESSENTRY32)  As  Long  
Private  Declare  Function  Process32Next  Lib    "kernel32  "  (ByVal  hSnapshot  As  Long,  lppe  As  PROCESSENTRY32)  As  Long  
Private  Declare  Function  CloseHandle  Lib    "kernel32  "  (ByVal  hObject  As  Long)  As  Long  
 
Private  Type  PROCESSENTRY32  
       dwSize  As  Long  
       cntUsage  As  Long  
       th32ProcessID  As  Long  
       th32DefaultHeapID  As  Long  
       th32ModuleID  As  Long  
       cntThreads  As  Long  
       th32ParentProcessID  As  Long  
       pcPriClassBase  As  Long  
       dwFlags  As  Long  
       szExeFile  As  String  *  1024  
End  Type  
 
Const  TH32CS_SNAPHEAPLIST  =  &H1  
Const  TH32CS_SNAPPROCESS  =  &H2  
Const  TH32CS_SNAPTHREAD  =  &H4  
Const  TH32CS_SNAPMODULE  =  &H8  
Const  TH32CS_SNAPALL  =  (TH32CS_SNAPHEAPLIST  Or  TH32CS_SNAPPROCESS  Or  TH32CS_SNAPTHREAD  Or  TH32CS_SNAPMODULE)  
Const  TH32CS_INHERIT  =  &H80000000  
 
Dim  pid  As  Long  
Dim  pname  As  String  
 
Private  Sub  Command1_Click()  
   Dim  my  As  PROCESSENTRY32  
   Dim  l  As  Long  
   Dim  l1  As  Long  
 
   l  =  CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,  0)  
   If  l  Then  
       my.dwSize  =  1060  
       If  (Process32First(l,  my))  Then  '遍历第一个进程  
           Do  
               If  my.szExeFile  =    "msnmsgr.exe  "  Then  
                         pid  =  my.th32ProcessID  
                         pname  =  my.szExeFile  
                         MsgBox    "找到msn  "  
                         Exit  Sub  
                 Else  
                         MsgBox    "没有找到msn  "  
                         Shell    "c:\windows\notepad.exe  ",  vbNormalFocus  
                         Exit  Sub  
                 End  If  
           Loop  Until  (Process32Next(l,  my)    <  1)  '遍历所有进程知道返回值为False  
       End  If  
       l1  =  CloseHandle(l)  
   End  If  
End  Sub  程序有错误，明明msn运行，但是还是提示没有运行，请online帮忙再看看

Answer 9

刚才msn没有装，只测试了未找到msn的情况
Private Sub Command1_Click()
  Dim my As PROCESSENTRY32
  Dim l As Long
  Dim l1 As Long
  Dim flag As Boolean
  Dim mName As String
  Dim i As Integer  l = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
  If l Then
    my.dwSize = 1060
    If (Process32First(l, my)) Then '遍历第一个进程
      Do
             '这里把名称后面的多余东西去掉
             i = InStr(1, my.szExeFile, Chr(0))
             mName = LCase(Left(my.szExeFile, i - 1))
        If mName = "msnmsgr.exe" Then
             pid = my.th32ProcessID
             pname = mName
             MsgBox "找到msn"
             flag = True
             Exit Sub
         Else
             flag = False
         End If
      Loop Until (Process32Next(l, my) < 1) '遍历所有进程知道返回值为False
    End If
    l1 = CloseHandle(l)
  End If
  
  If flag = False Then
    MsgBox "没有找到msn"
    Shell "c:\windows\notepad.exe", vbNormalFocus
  End If
End Sub