[Webinar] Streamline your web hosting managementRegister Today

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 160
  • Last Modified:

Determining what apps are currently running...

I need to know what applications are currently running in Winodws at the point my VB6 app executes. Is it possible to retrieve a list of all resident programs and perhaps even retrieve a little information from each of them (Window captions etc).
0
lbowers
Asked:
lbowers
  • 5
  • 5
1 Solution
 
watyCommented:
Here is some code :

' #VBIDEUtils#************************************************************
' * Programmer Name  : Chong Long Choo
' * Web Site         : www.geocities.com/ResearchTriangle/6311/
' * E-Mail           : chonglongchoo@hotmail.com
' * Date             : 13/09/1999
' * Time             : 11:31
' **********************************************************************
' * Comments         : List All Active Processes
' *
' *
' **********************************************************************
Option Explicit

'-----------------------------------------------------------
'How to use
'--------------------------------------------------------------
'    Dim i As Integer
'    Dim objItem As ListItem
'    Dim NumOfProcess As Long
'    Dim objActiveProcess As clsActiveProcess
'    Set objActiveProcess = New clsActiveProcess
'    NumOfProcess = objActiveProcess.GetActiveProcess
'    For i = 1 To NumOfProcess
'        Set objItem = ListView1.ListItems.Add(, , _
'            objActiveProcess.szExeFile(i))
'        With objItem
'           .SubItems(1) = objActiveProcess.th32ProcessID(i)
'           .SubItems(2) = objActiveProcess.th32DefaultHeapID(i)
'           .SubItems(3) = objActiveProcess.thModuleID(i)
'           .SubItems(4) = objActiveProcess.cntThreads(i)
'           .SubItems(5) = objActiveProcess.th32ParentProcessID _
'                (i)
'        End With
'    Next
'    Set objActiveProcess = Nothing
Private Const TH32CS_SNAPPROCESS As Long = 2&
Private Const MAX_PATH As Integer = 260

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 * MAX_PATH
End Type

Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long

Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long

Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long

Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)

Private ListOfActiveProcess() As PROCESSENTRY32

Public Function szExeFile(ByVal Index As Long) As String
   szExeFile = ListOfActiveProcess(Index).szExeFile
End Function

Public Function dwFlags(ByVal Index As Long) As Long
   dwFlags = ListOfActiveProcess(Index).dwFlags
End Function

Public Function pcPriClassBase(ByVal Index As Long) As Long
   pcPriClassBase = ListOfActiveProcess(Index).pcPriClassBase
End Function

Public Function th32ParentProcessID(ByVal Index As Long) As Long
   th32ParentProcessID = _
      ListOfActiveProcess(Index).th32ParentProcessID
End Function

Public Function cntThreads(ByVal Index As Long) As Long
   cntThreads = ListOfActiveProcess(Index).cntThreads
End Function

Public Function thModuleID(ByVal Index As Long) As Long
   thModuleID = ListOfActiveProcess(Index).th32ModuleID
End Function

Public Function th32DefaultHeapID(ByVal Index As Long) As Long
   th32DefaultHeapID = _
      ListOfActiveProcess(Index).th32DefaultHeapID
End Function

Public Function th32ProcessID(ByVal Index As Long) As Long
   th32ProcessID = ListOfActiveProcess(Index).th32ProcessID
End Function

Public Function cntUsage(ByVal Index As Long) As Long
   cntUsage = ListOfActiveProcess(Index).cntUsage
End Function

Public Function dwSize(ByVal Index As Long) As Long
   dwSize = ListOfActiveProcess(Index).dwSize
End Function

Public Function GetActiveProcess() As Long
   Dim hToolhelpSnapshot As Long
   Dim tProcess As PROCESSENTRY32
   Dim r As Long, i As Integer
   hToolhelpSnapshot = CreateToolhelpSnapshot _
      (TH32CS_SNAPPROCESS, 0&)
   If hToolhelpSnapshot = 0 Then
      GetActiveProcess = 0
      Exit Function
   End If
   With tProcess
      .dwSize = Len(tProcess)
      r = ProcessFirst(hToolhelpSnapshot, tProcess)
      ReDim Preserve ListOfActiveProcess(20)
      Do While r
         i = i + 1
         If i Mod 20 = 0 Then ReDim Preserve _
            ListOfActiveProcess(i + 20)
         ListOfActiveProcess(i) = tProcess
         r = ProcessNext(hToolhelpSnapshot, tProcess)
      Loop
   End With
   GetActiveProcess = i
   Call CloseHandle(hToolhelpSnapshot)
End Function
0
 
lbowersAuthor Commented:
First of all your answer is superb, but before I close this question I would like to know if it is possible to retrieve the windows captions of any processes/applications that have interfaces. I need to extract some information from the applications title bar... Thanks again...
0
Never miss a deadline with monday.com

The revolutionary project management tool is here!   Plan visually with a single glance and make sure your projects get done.

 
watyCommented:
' #VBIDEUtils#************************************************************
' * Programmer Name  : FreeVBCode
' * Web Site         : http://www.freevbcode.com/ShowCode.Asp?ID=487
' * E-Mail           : waty.thierry@usa.net
' * Date             : 17/11/1999
' * Time             : 09:52
' **********************************************************************
' * Comments         : Retrieve the Captions of All Open Top-Level Windows
' *
' *
' **********************************************************************
Option Explicit

Private Declare Function EnumWindows Lib "user32" _
   (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long

Private Declare Function GetWindowText Lib "user32" Alias _
   "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, _
   ByVal cch As Long) As Long

Private asTopLevelWindows() As String

Public Function TopLevelWindows() As String()

   'PURPOSE: RETURNS AN ARRAY OF TOPLEVEL WINDOWS
   'REQUIRES: VB 6
   'SAMPLE:
   'Dim sArray() As String
   'Dim iCtr As Integer

   'sArray = TopLevelWindows
   'For iCtr = 0 To UBound(sArray)
   'Debug.Print sArray(iCtr)
   'Next

   ReDim asTopLevelWindows(0) As String
   Dim lRet As Long
   lRet = EnumWindows(AddressOf AddElement, 0)
   TopLevelWindows = asTopLevelWindows
End Function

Private Function AddElement(ByVal lhWnd As Long, ByVal lParam As Long) As Long

   Dim sTitle As String
   Dim lRet As Long
   Dim iNew As Integer

   sTitle = Space(255)
   lRet = GetWindowText(lhWnd, sTitle, 255)

   sTitle = StripNull(sTitle)

   If sTitle <> "" Then
      If asTopLevelWindows(0) = "" Then
         iNew = 0
      Else
         iNew = UBound(asTopLevelWindows) + 1
         ReDim Preserve asTopLevelWindows(iNew) As String
      End If

      asTopLevelWindows(iNew) = sTitle

   End If

   AddElement = True

End Function

Private Function StripNull(ByVal InString As String) As String

   'Input: String containing null terminator (Chr(0))
   'Returns: all character before the null terminator

   Dim iNull As Integer
   If Len(InString) > 0 Then
      iNull = InStr(InString, vbNullChar)
      Select Case iNull
         Case 0
            StripNull = InString
         Case 1
            StripNull = ""
         Case Else
            StripNull = Left$(InString, iNull - 1)
      End Select
   End If

End Function
0
 
lbowersAuthor Commented:
Fantastic - I've upped the points to 150 as a thank you. Cheers.
0
 
lbowersAuthor Commented:
When running the "TopLevelWindows" exmaple code I get a "Can't Assign To Array" error on the line:

sArray = TopLevelWindows

What's wrong?
   
0
 
watyCommented:
If I remember well, you need VB6.
otherwise, you can pass the array as a parameter,
or declaring like this

Public Function TopLevelWindows() As Variant
0
 
lbowersAuthor Commented:
I am using Visual Basic 6 SP3...
0
 
watyCommented:
This is strange

pass the array as a parameter,
or declaring like this

Public Function TopLevelWindows() As Variant
0
 
lbowersAuthor Commented:
Waty,

Thanks again for your help.
I'd actually made a stupid error - I caled my .BAS file the same name as the function TopLevelWindows !!!

Sorry...
0

Featured Post

Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

  • 5
  • 5
Tackle projects and never again get stuck behind a technical roadblock.
Join Now