如何判断一个应用程序是否在执行，谢谢

Question

如题

Answer 1

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 Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As Long
 
Private Declare Function TerminateProcess Lib "kernel32" (ByVal ApphProcess As Long, ByVal uExitCode 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
   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 = "vb.exe" Then
                  MsgBox "已运行vb"
                         flag = True
                         Exit Sub
                 Else
                         flag = False
                 End If
           Loop Until (Process32Next(l, my) < 1)       '遍历所有进程知道返回值为False
       End If
       l1 = CloseHandle(l)
   End If
   End
End Sub

Answer 2

Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As String, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const INVALID_HANDLE_VALUE = -1Private Function IsFileRun(ByVal pFile As String) As Boolean
    Dim Ret As Long
    Ret = CreateFile(pFile, GENERIC_READ Or GENERIC_WRITE, 0&, vbNullString, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0&)
    IsFileRun = (Ret = INVALID_HANDLE_VALUE)
    CloseHandle Ret
End Functionprivate sub command1_click()
    if isfilerun("c:\windows\notepad.exe")=true then
        msgbox "记事本已运行！"
    else
        msgbox "记事本未运行！"
    end if
end sub注意：如果pFile是个不存在的文件，那么isfilerun也会返回true，所以最好先用dir判断一下。

Answer 3

谢谢各位解答，我在用如下的api时
Private Declare Function GetModuleUsage% Lib "Kernel" (ByVal hModule%)
总会提示file not found :Kernel ,为什么啊，奇怪

Answer 4

呵呵,你的声明写错了,应该是Kernel32 所以会提示你找不到文件Kernel

Answer 5

kernel32.dll只得是WIN32内核~!~!呵呵!!~!~