80083r
asked on
detect open programs (win98 or win2k)
Hi,
the company I am currently employed at (not as a programmer, more's the pity) requires that I do some very stupid cut and paste from one application to another.
In order to spend more time surfing the web for jokes (and to avoid carpal tunnel sydnrome) I am automating my task.
The background is this: I need to make a VB frontend to run a macro on a program called Outside.exe (some of you may be familiar with this. it's ver. 4.3a and the macro is written in Commbasic 1.0) VB does not need to communicate with Outside.exe for more than 2 things - and that is already worked out (mostly)
The problem is, when trying to initiate a DDE conversation, I need to first find out if "outside.exe" is running. If not, I will simply make a shell call.
Is there a simple way to do this? (I have seen the some documents on the Microsoft knowledge base - holy thousands of lines of code, batman)
Thanks in advance,
80083r
the company I am currently employed at (not as a programmer, more's the pity) requires that I do some very stupid cut and paste from one application to another.
In order to spend more time surfing the web for jokes (and to avoid carpal tunnel sydnrome) I am automating my task.
The background is this: I need to make a VB frontend to run a macro on a program called Outside.exe (some of you may be familiar with this. it's ver. 4.3a and the macro is written in Commbasic 1.0) VB does not need to communicate with Outside.exe for more than 2 things - and that is already worked out (mostly)
The problem is, when trying to initiate a DDE conversation, I need to first find out if "outside.exe" is running. If not, I will simply make a shell call.
Is there a simple way to do this? (I have seen the some documents on the Microsoft knowledge base - holy thousands of lines of code, batman)
Thanks in advance,
80083r
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
I recognise that code!
ASKER
A simple answer requested, a simple answer recieved. I will know the window title, as I am running the app from a shell call inside the VB app.
Thanks much
Thanks much
8->
ASKER
Of course, this is simpler :)
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Sub Form_Load()
Dim WinWnd As Long, Ret As String
'Ask for a Window title
Ret = InputBox("Enter the exact window title:" + Chr$(13) + Chr$(10) + "Note: must be an exact match")
'Search the window
WinWnd = FindWindow(vbNullString, Ret)
If WinWnd = 0 Then MsgBox "Couldn't find the window ...": Exit Sub
End Sub
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Sub Form_Load()
Dim WinWnd As Long, Ret As String
'Ask for a Window title
Ret = InputBox("Enter the exact window title:" + Chr$(13) + Chr$(10) + "Note: must be an exact match")
'Search the window
WinWnd = FindWindow(vbNullString, Ret)
If WinWnd = 0 Then MsgBox "Couldn't find the window ...": Exit Sub
End Sub
paste in form and add command button
Option Explicit
Private Sub Command1_Click()
Debug.Print GetProcesses("outside.exe"
End Sub
Paste in module
Option Explicit
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 GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFO) As Integer
Public Const PROCESS_QUERY_INFORMATION = 1024
Public Const PROCESS_VM_READ = 16
Public Const MAX_PATH = 260
Public Const WIN95_System_Found = 1
Public Const WINNT_System_Found = 2
Public Type PROCESS_MEMORY_COUNTERS
cb As Long
PageFaultCount As Long
PeakWorkingSetSize As Long
WorkingSetSize As Long
QuotaPeakPagedPoolUsage As Long
QuotaPagedPoolUsage As Long
QuotaPeakNonPagedPoolUsage
QuotaNonPagedPoolUsage As Long
PagefileUsage As Long
PeakPagefileUsage As Long
End Type
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 Function GetProcesses(ByVal EXEName As String) As Boolean
Dim booResult As Boolean
Dim lngLength As Long
Dim lngProcessID As Long
Dim strProcessName As String
Dim lngSnapHwnd As Long
Dim udtProcEntry As PROCESSENTRY32
Dim lngCBSize As Long 'Specifies the size, In bytes, of the lpidProcess array
Dim lngCBSizeReturned As Long 'Receives the number of bytes returned
Dim lngNumElements As Long
Dim lngProcessIDs() As Long
Dim lngCBSize2 As Long
Dim lngModules(1 To 200) As Long
Dim lngReturn As Long
Dim strModuleName As String
Dim lngSize As Long
Dim lngHwndProcess As Long
Dim lngLoop As Long
Dim b As Long
Dim c As Long
Dim e As Long
Dim d As Long
Dim pmc As PROCESS_MEMORY_COUNTERS
Dim lret As Long
Dim strProcName2 As String
Dim strProcName As String
'Turn on Error handler
On Error GoTo Error_handler
GetProcesses = False
booResult = False
EXEName = UCase$(Trim$(EXEName))
lngLength = Len(EXEName)
'ProcessInfo.bolRunning = False
Select Case GetVersion()
'I'm not bothered about windows 95/98 becasue this class probably wont be used on it anyway.
Case WIN95_System_Found 'Windows 95/98
Case WINNT_System_Found 'Windows NT
lngCBSize = 8 ' Really needs To be 16, but Loop will increment prior to calling API
lngCBSizeReturned = 96
Do While lngCBSize <= lngCBSizeReturned
DoEvents
'Increment Size
lngCBSize = lngCBSize * 2
'Allocate Memory for Array
ReDim lngProcessIDs(lngCBSize / 4) As Long
'Get Process ID's
lngReturn = EnumProcesses(lngProcessID
Loop
'Count number of processes returned
lngNumElements = lngCBSizeReturned / 4
'Loop thru each process
For lngLoop = 1 To lngNumElements
DoEvents
'Get a handle to the Process and Open
lngHwndProcess = OpenProcess(PROCESS_QUERY_
If lngHwndProcess <> 0 Then
'Get an array of the module handles for the specified process
lngReturn = EnumProcessModules(lngHwnd
'If the Module Array is retrieved, Get the ModuleFileName
If lngReturn <> 0 Then
'Buffer with spaces first to allocate memory for byte array
strModuleName = Space(MAX_PATH)
'Must be set prior to calling API
lngSize = 500
'Get Process Name
lngReturn = GetModuleFileNameExA(lngHw
'Remove trailing spaces
strProcessName = Left(strModuleName, lngReturn)
'get the long path and file name
strProcessName = GetLongFilename(strProcess
'Check for Matching Upper case result
strProcessName = UCase$(Trim$(strProcessNam
strProcName2 = GetElement(Trim(Replace(st
If strProcName2 = EXEName Then
GetProcesses = True
End If
End If
End If
'Close the handle to this process
lngReturn = CloseHandle(lngHwndProcess
DoEvents
Next
End Select
IsProcessRunning_Exit:
'Exit early to avoid error handler
Exit Function
Error_handler:
Err.Raise Err, Err.Source, "ProcessInfo", Error
Resume Next
End Function
Public Function GetVersion() As Long
Dim osinfo As OSVERSIONINFO
Dim retvalue As Integer
On Error Resume Next
osinfo.dwOSVersionInfoSize
osinfo.szCSDVersion = Space$(128)
retvalue = GetVersionExA(osinfo)
GetVersion = osinfo.dwPlatformId
End Function
Public Function StrZToStr(s As String) As String
On Error Resume Next
StrZToStr = Left$(s, Len(s) - 1)
End Function
Public Function GetElement(ByVal strList As String, ByVal strDelimiter As String, ByVal lngNumColumns As Long, ByVal lngRow As Long, ByVal lngColumn As Long) As String
Dim lngCounter As Long
On Error Resume Next
' Append delimiter text to the end of the list as a terminator.
strList = strList & strDelimiter
' Calculate the offset for the item required based on the number of columns the list
' 'strList' has i.e. 'lngNumColumns' and from which row the element is to be
' selected i.e. 'lngRow'.
lngColumn = IIf(lngRow = 0, lngColumn, (lngRow * lngNumColumns) + lngColumn)
' Search for the 'lngColumn' item from the list 'strList'.
For lngCounter = 0 To lngColumn - 1
' Remove each item from the list.
strList = Mid$(strList, InStr(strList, strDelimiter) + Len(strDelimiter), Len(strList))
' If list becomes empty before 'lngColumn' is found then just
' return an empty string.
If Len(strList) = 0 Then
GetElement = ""
Exit Function
End If
Next lngCounter
' Return the sought list element.
GetElement = Left$(strList, InStr(strList, strDelimiter) - 1)
End Function
Public Function GetNumElements(ByVal strList As String, ByVal strDelimiter As String) As Integer
Dim intElementCount As Integer
On Error Resume Next
' If no elements in the list 'strList' then just return 0.
If Len(strList) = 0 Then
GetNumElements = 0
Exit Function
End If
' Append delimiter text to the end of the list as a terminator.
strList = strList & strDelimiter
' Count the number of elements in 'strlist'
While InStr(strList, strDelimiter) > 0
intElementCount = intElementCount + 1
strList = Mid$(strList, InStr(strList, strDelimiter) + 1, Len(strList))
Wend
' Return the number of elements in 'strList'.
GetNumElements = intElementCount
End Function
Public Function GetLongFilename(ByVal sShortName As String) As String
Dim sLongName As String
Dim sTemp As String
Dim iSlashPos As Integer
On Error Resume Next
'Add \ to short name to prevent Instr from failing
sShortName = sShortName & "\"
'Start from 4 to ignore the "[Drive Letter]:\" characters
iSlashPos = InStr(4, sShortName, "\")
'Pull out each string between \ character for conversion
While iSlashPos
sTemp = Dir(Left$(sShortName, iSlashPos - 1), _
vbNormal + vbHidden + vbSystem + vbDirectory)
If sTemp = "" Then
'Error 52 - Bad File Name or Number
GetLongFilename = ""
Exit Function
End If
sLongName = sLongName & "\" & sTemp
iSlashPos = InStr(iSlashPos + 1, sShortName, "\")
Wend
'Prefix with the drive letter
GetLongFilename = Left$(sShortName, 2) & sLongName
End Function