Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

detect open programs (win98 or win2k)

Posted on 2003-03-19
6
Medium Priority
?
262 Views
Last Modified: 2010-04-07
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
0
Comment
Question by:80083r
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2
  • 2
6 Comments
 
LVL 43

Accepted Solution

by:
TimCottee earned 1000 total points
ID: 8165832
Hi 80083r,

The simplest way probably is to use the FindWindow api call assuming that you know the text that is displayed in the Outside.exe's form caption. This will return either a valid handle (in which case the application is running) or not (in which case it isn't).

Here is a relatively simple example:

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Const SW_SHOWNORMAL = 1
Const WM_CLOSE = &H10
Const gcClassnameMSWord = "OpusApp"
Const gcClassnameMSExcel = "XLMAIN"
Const gcClassnameMSIExplorer = "IEFrame"
Const gcClassnameMSVBasic = "wndclass_desked_gsk"
Const gcClassnameNotePad = "Notepad"
Const gcClassnameMyVBApp = "ThunderForm"
Private Sub Form_Load()
    'KPD-Team 1998
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    Dim WinWnd As Long, Ret As String, RetVal As Long, lpClassName 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
    'Show the window
    ShowWindow WinWnd, SW_SHOWNORMAL
    'Create a buffer
    lpClassName = Space(256)
    'retrieve the class name
    RetVal = GetClassName(WinWnd, lpClassName, 256)
    'Show the classname
    MsgBox "Classname: " + Left$(lpClassName, RetVal)
    'Post a message to the window to close itself
    PostMessage WinWnd, WM_CLOSE, 0&, 0&
End Sub


Tim Cottee MCSD, MCDBA, CPIM
http://www.timcottee.tk 

Brainbench MVP for Visual Basic
http://www.brainbench.com

Experts-Exchange Advisory Board Member
0
 
LVL 26

Expert Comment

by:EDDYKT
ID: 8166132
I use this one, pass task name in


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 As Long
    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(lngProcessIDs(1), lngCBSize, lngCBSizeReturned)
            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_INFORMATION Or PROCESS_VM_READ, 0, lngProcessIDs(lngLoop))

            If lngHwndProcess <> 0 Then
                'Get an array of the module handles for the specified process
                lngReturn = EnumProcessModules(lngHwndProcess, lngModules(1), 200, lngCBSize2)

                '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(lngHwndProcess, lngModules(1), strModuleName, lngSize)

                    'Remove trailing spaces
                    strProcessName = Left(strModuleName, lngReturn)
                   
                     'get the long path and file name
                    strProcessName = GetLongFilename(strProcessName)

                   'Check for Matching Upper case result
                    strProcessName = UCase$(Trim$(strProcessName))

                    strProcName2 = GetElement(Trim(Replace(strProcessName, Chr$(0), "")), "\", 0, 0, GetNumElements(Trim(Replace(strProcessName, Chr$(0), "")), "\") - 1)
                    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 = 148
    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


0
 
LVL 43

Expert Comment

by:TimCottee
ID: 8166195
I recognise that code!
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 

Author Comment

by:80083r
ID: 8166251
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
0
 
LVL 26

Expert Comment

by:EDDYKT
ID: 8166267
8->
0
 

Author Comment

by:80083r
ID: 8172058
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
0

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Suggested Courses

721 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question