Board logo

标题: 如何列举所有正在运行的进程? [打印本页]

作者: VB菜鸟    时间: 2005-7-14 21:10     标题: 如何列举所有正在运行的进程?

如何列举所有正在运行的进程?
作者: Nothing    时间: 2005-7-14 21:11

模块:  
Option  Explicit  
Public  Declare  Function  Process32First  Lib  "kernel32"  (  _  
       ByVal  hSnapshot  As  Long,  lppe  As  PROCESSENTRY32)  As  Long  
Public  Declare  Function  Process32Next  Lib  "kernel32"  (  _  
       ByVal  hSnapshot  As  Long,  lppe  As  PROCESSENTRY32)  As  Long  
Public  Declare  Function  CloseHandle  Lib  "Kernel32.dll"  _  
       (ByVal  Handle  As  Long)  As  Long  
Public  Declare  Function  OpenProcess  Lib  "Kernel32.dll"  _  
     (ByVal  dwDesiredAccessas  As  Long,  ByVal  bInheritHandle  As  Long,  _  
             ByVal  dwProcId  As  Long)  As  Long  
Public  Declare  Function  EnumProcesses  Lib  "psapi.dll"  _  
       (ByRef  lpidProcess  As  Long,  ByVal  cb  As  Long,  _  
             ByRef  cbNeeded  As  Long)  As  Long  
Public  Declare  Function  GetModuleFileNameExA  Lib  "psapi.dll"  _  
       (ByVal  hProcess  As  Long,  ByVal  hModule  As  Long,  _  
             ByVal  ModuleName  As  String,  ByVal  nSize  As  Long)  As  Long  
Public  Declare  Function  EnumProcessModules  Lib  "psapi.dll"  _  
       (ByVal  hProcess  As  Long,  ByRef  lphModule  As  Long,  _  
             ByVal  cb  As  Long,  ByRef  cbNeeded  As  Long)  As  Long  
Public  Declare  Function  CreateToolhelp32Snapshot  Lib  "kernel32"  (  _  
       ByVal  dwFlags  As  Long,  ByVal  th32ProcessID  As  Long)  As  Long  
Public  Declare  Function  GetVersionExA  Lib  "kernel32"  _  
       (lpVersionInformation  As  OSVERSIONINFO)  As  Integer  
Public  Type  PROCESSENTRY32  
       dwSize  As  Long  
       cntUsage  As  Long  
       th32ProcessID  As  Long                      '  This  process  
       th32DefaultHeapID  As  Long  
       th32ModuleID  As  Long                        '  Associated  exe  
       cntThreads  As  Long  
       th32ParentProcessID  As  Long          '  This  process's  parent  process  
       pcPriClassBase  As  Long                    '  Base  priority  of  process  threads  
       dwFlags  As  Long  
       szExeFile  As  String  *  260              '  MAX_PATH  
End  Type  
Public  Type  OSVERSIONINFO  
       dwOSVersionInfoSize  As  Long  
       dwMajorVersion  As  Long  
       dwMinorVersion  As  Long  
       dwBuildNumber  As  Long  
       dwPlatformId  As  Long                    '1  =  Windows  95.  
                                                                     '2  =  Windows  NT  
       szCSDVersion  As  String  *  128  
End  Type  
Public  Const  PROCESS_QUERY_INFORMATION  =  1024  
Public  Const  PROCESS_VM_READ  =  16  
Public  Const  MAX_PATH  =  260  
Public  Const  STANDARD_RIGHTS_REQUIRED  =  &HF0000  
Public  Const  SYNCHRONIZE  =  &H100000  
'STANDARD_RIGHTS_REQUIRED  Or  SYNCHRONIZE  Or  &HFFF  
Public  Const  PROCESS_ALL_ACCESS  =  &H1F0FFF  
Public  Const  TH32CS_SNAPPROCESS  =  &H2&  
Public  Const  hNull  =  0  

Function  StrZToStr(s  As  String)  As  String  
       StrZToStr  =  Left$(s,  Len(s)  -  1)  
End  Function  

Public  Function  getVersion()  As  Long  
       Dim  osinfo  As  OSVERSIONINFO  
       Dim  retvalue  As  Integer  
       osinfo.dwOSVersionInfoSize  =  148  
       osinfo.szCSDVersion  =  Space$(128)  
       retvalue  =  GetVersionExA(osinfo)  
       getVersion  =  osinfo.dwPlatformId  
End  Function  

窗体:(一个按钮,一个listbox,如果不需要显示可设为不可见)  
Option  Explicit  

Private  Sub  Command1_Click()  
List1.Clear  
Select  Case  getVersion()  

Case  1  'Windows  95/98  

     Dim  f  As  Long,  sname  As  String  
     Dim  hSnap  As  Long,  proc  As  PROCESSENTRY32  
     hSnap  =  CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,  0)  
     If  hSnap  =  hNull  Then  Exit  Sub  
     proc.dwSize  =  Len(proc)  
     '  Iterate  through  the  processes  
     f  =  Process32First(hSnap,  proc)  
     Do  While  f  
         sname  =  StrZToStr(proc.szExeFile)  
         List1.AddItem  sname  
         f  =  Process32Next(hSnap,  proc)  
     Loop  

Case  2  'Windows  NT  

     Dim  cb  As  Long  
     Dim  cbNeeded  As  Long  
     Dim  NumElements  As  Long  
     Dim  ProcessIDs()  As  Long  
     Dim  cbNeeded2  As  Long  
     Dim  NumElements2  As  Long  
     Dim  Modules(1  To  200)  As  Long  
     Dim  lRet  As  Long  
     Dim  ModuleName  As  String  
     Dim  nSize  As  Long  
     Dim  hProcess  As  Long  
     Dim  i  As  Long  
     'Get  the  array  containing  the  process  id's  for  each  process  object  
     cb  =  8  
     cbNeeded  =  96  
     Do  While  cb  <=  cbNeeded  
           cb  =  cb  *  2  
           ReDim  ProcessIDs(cb  /  4)  As  Long  
           lRet  =  EnumProcesses(ProcessIDs(1),  cb,  cbNeeded)  
     Loop  
     NumElements  =  cbNeeded  /  4  

     For  i  =  1  To  NumElements  
           'Get  a  handle  to  the  Process  
           hProcess  =  OpenProcess(PROCESS_QUERY_INFORMATION  _  
                 Or  PROCESS_VM_READ,  0,  ProcessIDs(i))  
           'Got  a  Process  handle  
           If  hProcess  <>  0  Then  
                   'Get  an  array  of  the  module  handles  for  the  specified  
                   'process  
                   lRet  =  EnumProcessModules(hProcess,  Modules(1),  200,  _  
                                                                             cbNeeded2)  
                   'If  the  Module  Array  is  retrieved,  Get  the  ModuleFileName  
                   If  lRet  <>  0  Then  
                         ModuleName  =  Space(MAX_PATH)  
                         nSize  =  500  
                         lRet  =  GetModuleFileNameExA(hProcess,  Modules(1),  _  
                                                         ModuleName,  nSize)  
                         List1.AddItem  Left(ModuleName,  lRet)  
                   End  If  
           End  If  
       'Close  the  handle  to  the  process  
     lRet  =  CloseHandle(hProcess)  
     Next  

End  Select  
MsgBox  IsRun("winamp的路径")  
End  Sub  

Private  Function  IsRun(ByVal  filename  As  String)  As  Boolean  
       Dim  i  As  Long  
       IsRun  =  False  
       For  i  =  1  To  List1.ListCount  
       Debug.Print  List1.List(i)  
               If  List1.List(i)  =  UCase(filename)  Then  
                 
                       IsRun  =  True  
                       Exit  Function  
               End  If  
       Next  

End  Function




欢迎光临 编程开发论坛 (http://bbs.lihuasoft.net/) Powered by Discuz! 6.0.0