Re: Detecting a running process.
- From: "Randy Birch" <rgb_removethis@xxxxxxxx>
- Date: Mon, 2 May 2005 22:20:49 -0400
Hi Steve ...
Here's a roughly-comment version broken into different routines ... same
thing, just a bit longer ...
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2005 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const PROCESS_QUERY_INFORMATION As Long = 1024
Private Const PROCESS_VM_READ As Long = 16
Private Const MAX_PATH As Long = 260
Private Declare Function EnumProcesses Lib "psapi.dll" _
(lpidProcess As Long, _
ByVal cb As Long, _
cbNeeded As Long) As Long
Private Declare Function EnumProcessModules Lib "psapi.dll" _
(ByVal dwProcessID As Long, _
lphModule As Long, _
ByVal cb As Long, _
cbNeeded As Long) As Long
Private Declare Function GetModuleFileNameEx Lib "psapi.dll" _
Alias "GetModuleFileNameExA" _
(ByVal dwProcessID As Long, _
ByVal hModule As Long, _
ByVal ModuleName As String, _
ByVal nSize As Long) As Long
Private Declare Function OpenProcess Lib "kernel32.dll" _
(ByVal dwDesiredAccessas As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcID As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" _
(ByVal Handle As Long) As Long
Private Sub Command1_Click()
Dim nProcesses As Long
Dim dwProcID() As Long
Dim sProcName As String
Dim cnt As Long
'simple demo to retrieve NT process
'ID's and the base filename associated
'with that process
'fill an array of longs with the
'process identifier for each process
'object in the system, returning the
'number of valid array members as a
'sign of success
nProcesses = GetNTProcessCount(dwProcID())
'Process IDs in and of themselves are not
'altogether thrilling, so retrive something
'more useful .. the module associated with
'the process.
If nProcesses > 0 Then
For cnt = 1 To nProcesses
sProcName = GetNTProcessFileName(dwProcID(cnt))
If Len(sProcName) > 0 Then
List1.AddItem dwProcID(cnt) & vbTab & sProcName
End If
Next
End If
End Sub
Private Function GetNTProcessCount(dwProcID() As Long) As Long
Dim cb As Long
Dim cbNeeded As Long
'In the EnumProcesses call, the cb member
'specifies the size, *in bytes* (not members),
'of the dwProcID array passed. Since the
'array is defined As Long, the each member
'is 4 bytes. Following the call, the cbNeeded
'variable receives the number of bytes returned
'in the dwProcID array.
'Unlike many other Win32 APIs, EnumProcesses
'will not return a value to indicate the needed
'size of the array by passing null or -1 as the
'cb parameter. Therefore the API needs to be
'repeatedly called until a buffer array large
'enough for all process IDs has finally been
'passed.
'Therefore, if, following the call, cbNeeded
'indicates a value higher than the initial
'size of the array passed, more data is
'available so the array needs to be resized
'to accomodate all entries. And because the
'array is populated in the single call,
'there is no purpose in using a Redim Preserve
'against the existing data that has filled the
'too-small array.
'Initially set cb to an arbitaray values, in
'multiples of 4 (the size of a Long) to allow
'the following loop to execute at least once
cb = 128
Do
'Increment the value of cb and size
'the array accordingly.
'Remember - cb specifies bytes, not members,
'so the Redim has to divide by the size of
'a long to set the correct member size.
'This is also one case where its much easier
'(and cleaner reading) to use a one-based
'array instead of a 0-based array.
cb = cb * 2
ReDim dwProcID(1 To (cb \ 4)) As Long
Call EnumProcesses(dwProcID(1), cb, cbNeeded)
'as long as cbNeeded is more than cb,
'increase the array size and call again
Loop While cbNeeded >= cb
'Following a successful call to EnumProcesses,
'cbNeeded indicates how many bytes the final
'array occupies. Normally it would be prudent
'to remove the unused array elements using a
'Redim Preserve call, and this should be done
'if the resultant array will be used elsewhere
'in some fashion. But in this case, a one-time
'use with the upper limit of valid members
'available via simple division against cbNeeded,
'we're just going to determine the last valid
'entry in order to loop through the valid members.
'Return the number of valid members in the
'passed dwProcId array
GetNTProcessCount = cbNeeded \ 4
End Function
Private Function GetNTProcessFileName(ByVal dwProcessID As Long) As String
Dim hModule As Long
Dim cbNeeded As Long
Dim sModule As String
Dim nSuccess As Long
'The first module associated with the process
'is the 'parent' module, so instead of the
'requisite array, we'll pass a simple long
'in which EnumProcessModules can return the
'handle to module associated with the process.
'But in order to otain info about a process,
'it is necessary to first obtain a handle
'to the process ID specified in dwProcessID.
'Desired access value PROCESS_QUERY_INFORMATION
'enables using the process handle in functions
'that read information from the process object,
'while the PROCESS_VM_READ value enables using
'the process handle to read from the virtual
'memory of the process.
dwProcessID = OpenProcess(PROCESS_QUERY_INFORMATION _
Or PROCESS_VM_READ, _
0, _
dwProcessID)
If dwProcessID <> 0 Then
'get the first module handle to
'the specified process. 4 is passed
'as cb representing the size, in bytes,
'of the hModule variable.
If EnumProcessModules(dwProcessID, _
hModule, _
4, _
cbNeeded) <> 0 Then
'create a buffer into which the
'module path and file are returned.
'The call returns 0 if failed, or
'the number of chrs in the retrieved
'string if successful.
'In place of assigning the result to
'a string, the If statement could be
'evaluated to > 0, and if successful
'the sModule value passed to a TrimNull
'function call in order to extract
'the module file name. This is a
'matter of perference.
sModule = Space(MAX_PATH)
nSuccess = GetModuleFileNameEx(dwProcessID, _
hModule, _
sModule, _
Len(sModule))
If nSuccess > 0 Then
GetNTProcessFileName = Left$(sModule, nSuccess)
End If
End If 'If EnumProcessModules
'clean up by closing the process handle
Call CloseHandle(dwProcessID)
End If 'If dwProcessID
End Function
--
Randy Birch
MS MVP Visual Basic
http://vbnet.mvps.org/
----------------------------------------------------------------------------
Read. Decide. Sign the petition to Microsoft.
http://classicvb.org/petition/
----------------------------------------------------------------------------
"Steve Easton" <admin@xxxxxxxxxxxxx> wrote in message
news:e%23O3DG4TFHA.4092@xxxxxxxxxxxxxxxxxxxxxxx
: Hi Randy.
: Thanks for the response and feedback.
:
: I need a little time to "absorb" all of this new information..
:
: ;-)
:
: --
: Steve Easton
: Microsoft MVP FrontPage
: 95isalive
: This site is best viewed............
: .......................with a computer
:
: "Randy Birch" <rgb_removethis@xxxxxxxx> wrote in message
: news:uvRuyU3TFHA.1148@xxxxxxxxxxxxxxxxxxxxxxx
: > Hi Steve ...
: >
: > For NT you have to use the EnumProcesses APIs and friends. Since this is
an
: > NT4 or later API method, you'll need code from
: > http://vbnet.mvps.org/code/helpers/iswinversion.htm to determine the OS
: > version and branch accordingly.
: >
: > Private Const PROCESS_QUERY_INFORMATION As Long = 1024
: > Private Const PROCESS_VM_READ As Long = 16
: > Private Const MAX_PATH As Long = 260
: >
: > Private Declare Function EnumProcesses Lib "psapi.dll" _
: > (lpidProcess As Long, _
: > ByVal cb As Long, _
: > cbNeeded As Long) As Long
: >
: > Private Declare Function EnumProcessModules Lib "psapi.dll" _
: > (ByVal dwProcessID As Long, _
: > lphModule As Long, _
: > ByVal cb As Long, _
: > cbNeeded As Long) As Long
: >
: > Private Declare Function GetModuleFileNameEx Lib "psapi.dll" _
: > Alias "GetModuleFileNameExA" _
: > (ByVal dwProcessID As Long, _
: > ByVal hModule As Long, _
: > ByVal ModuleName As String, _
: > ByVal nSize As Long) As Long
: >
: > Private Declare Function OpenProcess Lib "kernel32.dll" _
: > (ByVal dwDesiredAccessas As Long, _
: > ByVal bInheritHandle As Long, _
: > ByVal dwProcID As Long) As Long
: >
: > Private Declare Function CloseHandle Lib "kernel32.dll" _
: > (ByVal Handle As Long) As Long
: >
: >
: > Private Sub Command1_Click()
: >
: > Dim cb As Long
: > Dim cbNeeded As Long
: > Dim nProcesses As Long
: > Dim cnt As Long
: > Dim hModule As Long
: > Dim sModule As String
: > Dim nSuccess As Long
: > Dim dwProcessID As Long
: >
: > 'arbitrary array size to start ...
: > 'as long as cbNeeded is more than cb,
: > 'increase the array size and call again
: > cb = 128
: > Do
: > cb = cb * 2
: > ReDim dwProcID(1 To (cb \ 4)) As Long
: > Call EnumProcesses(dwProcID(1), cb, cbNeeded)
: > Loop While cbNeeded >= cb
: >
: > nProcesses = cbNeeded \ 4
: >
: > If nProcesses > 0 Then
: >
: > For cnt = 1 To nProcesses
: >
: > dwProcessID = OpenProcess(PROCESS_QUERY_INFORMATION _
: > Or PROCESS_VM_READ, _
: > 0, _
: > dwProcID(cnt))
: >
: > If dwProcessID <> 0 Then
: >
: > If EnumProcessModules(dwProcessID, _
: > hModule, _
: > 4, _
: > cbNeeded) <> 0 Then
: >
: >
: > sModule = Space(MAX_PATH)
: > nSuccess = GetModuleFileNameEx(dwProcessID, _
: > hModule, _
: > sModule, _
: > Len(sModule))
: >
: > If nSuccess > 0 Then
: > List1.AddItem dwProcID(cnt) & vbTab & Left$(sModule,
: > nSuccess)
: > End If
: >
: > End If
: >
: > Call CloseHandle(dwProcessID)
: >
: > End If
: >
: > Next
: >
: > End If
: >
: > End Sub
: >
: >
: > --
: >
: > Randy Birch
: > MS MVP Visual Basic
: > http://vbnet.mvps.org/
:
> ----------------------------------------------------------------------------
: > Read. Decide. Sign the petition to Microsoft.
: > http://classicvb.org/petition/
:
> ----------------------------------------------------------------------------
: >
: >
: >
: > "Steve Easton" <admin@xxxxxxxxxxxxx> wrote in message
: > news:udtE3C2TFHA.2664@xxxxxxxxxxxxxxxxxxxxxxx
: > :I found a script to detect running process here:
: > : http://vbnet.mvps.org/index.html?code/system/toolhelpprocesses.htm
: > :
: > : However, I modified it to scan the processes and set a string variable
to
: > 1 if one certain process
: > : is running as follows:
: > :
: > : Dim hSnapShot As Long
: > : Dim isrun As String
: > : Dim uProcess As PROCESSENTRY32
: > : Dim success As Long
: > : Const frontp As String = "FRONTPG.EXE"
: > : hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&)
: > : If hSnapShot = -1 Then Exit Sub
: > : uProcess.dwSize = Len(uProcess)
: > : success = ProcessFirst(hSnapShot, uProcess)
: > : If success = 1 Then
: > : isrun = 0
: > : Do
: > : If Left$(uProcess.szExeFile, 11) = frontp Then isrun =
isrun +
: > 1
: > : Loop While ProcessNext(hSnapShot, uProcess)
: > : End If
: > : Call CloseHandle(hSnapShot)
: > :
: > : At this point if FRONTPG.EXE is running the value isrun = 1
: > : and I use it to open a message box alerting the user to close
FrontPage
: > before continuing.
: > :
: > : Problem is, it won't work in windows NT because
CreateToolhelp32Snapshot
: > isn't available on NT
: > :
: > : So, my questions are, Is there a better way to do this and is there a
way
: > that's compatible with NT.
: > :
: > : tyia
: > :
: > :
: > : --
: > : Steve Easton
: > : Microsoft MVP FrontPage
: > : 95isalive
: > : This site is best viewed............
: > : .......................with a computer
: > :
: > :
: >
:
:
.
- References:
- Detecting a running process.
- From: Steve Easton
- Re: Detecting a running process.
- From: Randy Birch
- Re: Detecting a running process.
- From: Steve Easton
- Detecting a running process.
- Prev by Date: Re: Detecting a running process.
- Next by Date: Re: Detecting a running process.
- Previous by thread: Re: Detecting a running process.
- Next by thread: Re: Detecting a running process.
- Index(es):
Relevant Pages
|
