Results 1 to 8 of 8

Thread: Closing another program

  1. #1

    Thread Starter
    Fanatic Member AccessShell's Avatar
    Join Date
    Oct 2013
    Posts
    790

    Question Closing another program

    From 1 VB program can I determine if another VB program is executing and if so can I close it from the checking program?

    Thanks

  2. #2
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,817

    Re: Closing another program

    Hi AccessShell,

    Well, "close" can mean a few different things. If you mean kill it (as you'd do in the task manager), here's a little procedure that uses the WMI to kill a process.

    Code:
    
    Public Sub KillProcess(ByVal sProcessName As String)
        ' Kill process using Visual Basic 6 0 and WMI.
        ' The full .exe name (including the .exe) is supplied, but no path.
        ' Example: KillProcess "excel.exe"
        ' BE CAREFUL:  No prompt for saving takes place.
        '              ALSO, it kills all occurrences.
        Dim oWMI As Object
        Dim ret As Long
        Dim oServices As Object
        Dim oService As Object
        Dim sServiceName As String
        Dim bFoundOne As Boolean
        '
        On Error Resume Next
            sProcessName = LCase$(sProcessName)
            Set oWMI = GetObject("WinMgmts:")
            Set oServices = oWMI.InstancesOf("win32_process")
            '
            Do
                For Each oService In oServices
                    sServiceName = LCase$(Trim$(CStr(oService.Name)))
                    If sServiceName = sProcessName Then
                        ret = oService.Terminate
                        bFoundOne = True
                    End If
                Next oService
                If Not bFoundOne Then Exit Do
                If Err Then Exit Do
                bFoundOne = False
            Loop
        On Error GoTo 0
    End Sub
    
    
    Be careful with that code though. It will kill the process, not giving the user any opportunity to save any unsaved data.

    If you're thinking of something else, please provide more details.

    Also, that above procedure could be fairly easily modified to just tell you whether or not the other process was running (without killing it).

    Good Luck,
    Elroy

    EDIT1: Another, possibly more polite way would be to identify individual windows of this other application, and then send a close command to them. That would possibly cause a prompt, asking the user if they wished to save data.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  3. #3

    Thread Starter
    Fanatic Member AccessShell's Avatar
    Join Date
    Oct 2013
    Posts
    790

    Re: Closing another program

    I want to close the program gracefully, just as if I would on a end button on a form. There is nothing to save on the program being remotely closed. I just think killing the process is "over kill" (extreme).

  4. #4
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,817

    Re: Closing another program

    Ok, well, if this other program only has one window, and you can find it, you can do something like the following:

    Code:
    
    Option Explicit
    '
    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 Const WM_CLOSE = &H10
    '
    
    Public Sub CloseWindow(hWnd As Long)
        ' PostMessage is used so that we don't hang our program.
        ' PostMessage just puts the message on the queue.
        ' If we used SendMessage, we would not return until the message was processed.
        PostMessage hWnd, WM_CLOSE, 0&, ByVal 0&
    End Sub
    
    
    You can use FindWindow to find your window if you know either its title or its class name:

    Code:
    
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Long, ByVal lpWindowName As Long) As Long
    
    Good Luck,
    Elroy
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  5. #5

    Thread Starter
    Fanatic Member AccessShell's Avatar
    Join Date
    Oct 2013
    Posts
    790

    Re: Closing another program

    WOW. More complicated than I thought. I will try later. Hopefully today. I will let you know.

    Thanks

  6. #6
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,817

    Re: Closing another program

    Alright, here's a "chunk" of code for you that might help. Focus on that hWndFromPartTitle procedure. You may also be able to simplify it for your needs. I just cobbled together everything needed to make it run the way I had it set up.

    Code:
    
    Option Explicit
    '
    Private Declare Function GetDesktopWindow Lib "user32" () As Long
    Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
    Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd 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 Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
    Private Declare Function EnumProcessModules Lib "psapi" (ByVal hProcess As Long, lphModule As Long, ByVal cb As Long, lpcbNeeded As Long) As Long
    Private Declare Function GetModuleFileNameExW Lib "psapi" (ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFileName As Long, ByVal nSize As Long) As Long
    Private Declare Function GetModuleBaseNameW Lib "psapi" (ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFileName As Long, ByVal nSize As Long) As Long
    Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) 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 GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
    '
    Private Const GW_HWNDFIRST = 0
    Private Const GW_HWNDLAST = 1
    Private Const GW_HWNDNEXT = 2
    Private Const GW_HWNDPREV = 3
    Private Const GW_OWNER = 4
    Private Const GW_CHILD = 5
    Private Const GW_MAX = 5
    '
    Private Const PROCESS_ALL_ACCESS = &H1F0FFF
    Private Const MAX_PATH_W = 260&
    '
    
    Public Function hWndFromPartTitle(sTitle As String, Optional sExeFileNameToMatch As String, Optional sClassToMatch As String, Optional bUseInstr As Boolean) As Long
        ' Returns zero if not found.
        Dim hWnd As Long
        hWnd = 0
        Do
            hWnd = hWndOfNextTopLevelWindow(hWnd)
            If hWnd = 0 Then
                hWndFromPartTitle = 0
                Exit Do
            Else
                If Left$(WindowText(hWnd), Len(sTitle)) = sTitle Or (bUseInstr And (InStr(WindowText(hWnd), sTitle) > 0)) Then
                    Select Case True
                    Case Len(sExeFileNameToMatch) <> 0 And Len(sClassToMatch) <> 0
                        If LCase$(ExeFileName(hWnd)) = LCase$(sExeFileNameToMatch) And LCase$(WindowClass(hWnd)) = LCase$(sClassToMatch) Then
                            hWndFromPartTitle = hWnd
                            Exit Do
                        End If
                    Case Len(sExeFileNameToMatch) <> 0
                        If LCase$(ExeFileName(hWnd)) = LCase$(sExeFileNameToMatch) Then
                            hWndFromPartTitle = hWnd
                            Exit Do
                        End If
                    Case Len(sClassToMatch) <> 0
                        If LCase$(WindowClass(hWnd)) = LCase$(sClassToMatch) Then
                            hWndFromPartTitle = hWnd
                            Exit Do
                        End If
                    Case Else
                        hWndFromPartTitle = hWnd
                        Exit Do
                    End Select
                End If
            End If
        Loop
    End Function
    
    Public Function hWndOfNextTopLevelWindow(hWnd As Long) As Long
        ' if hWnd=0 then the first window is returned.
        Dim l As Long
        If hWnd = 0 Then
            ' The desktop is the highest window
            l = GetDesktopWindow()
            ' It's first child is the 1st top level window
            hWndOfNextTopLevelWindow = GetWindow(l, GW_CHILD)
        Else
            hWndOfNextTopLevelWindow = GetWindow(hWnd, GW_HWNDNEXT)
        End If
    End Function
    
    Public Function WindowText(hWndOfInterest As Long) As String
        ' Form or control.
        Dim s As String
        Dim l As Long
        '
        l = GetWindowTextLength(hWndOfInterest)
        s = Space$(l + 1)
        l = GetWindowText(hWndOfInterest, s, l + 1)
        s = RTrimNull(s)
        WindowText = Trim$(s)
    End Function
    
    Public Function ExeFileName(hWndOfInterest As Long, Optional FullSpec As Boolean) As String
        Dim rtn As Long
        Dim lProcMods() As Long
        Dim sFileName As String
        Dim lSize As Long
        Dim lRequired As Long
        Dim hProcess As Long
        Dim hWndOfFormWithFocus As Long
        Dim l As Long
        '
        lSize = 4
        ReDim lProcMods(0)
        '
        hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0&, ProcessID(hWndOfInterest))
        ' Enumerate modules.
        rtn = EnumProcessModules(hProcess, lProcMods(0), lSize, lRequired)
        ' If array is not large enough to hold all results, number of bytes required is in lRequired.
        If lRequired > lSize Then
            lSize = lRequired
            ReDim lProcMods(0 To (lSize / 4) - 1)
            rtn = EnumProcessModules(hProcess, lProcMods(0), lSize, lRequired)
        End If
        ' lProcMods() now holds the list of module handles associated with the process.
        ' The zeroth element is the main program.
        sFileName = String$(MAX_PATH_W, 0)
        If FullSpec Then
            rtn = GetModuleFileNameExW(hProcess, lProcMods(0), StrPtr(sFileName), Len(sFileName))
        Else
            rtn = GetModuleBaseNameW(hProcess, lProcMods(0), StrPtr(sFileName), Len(sFileName))
        End If
        ExeFileName = Left$(sFileName, rtn)
        rtn = CloseHandle(hProcess)
    End Function
    
    Public Function WindowClass(hWndOfInterest As Long) As String
        WindowClass = String$(1024, 0)
        WindowClass = Left$(WindowClass, GetClassName(hWndOfInterest, WindowClass, 1024&))
    End Function
    
    Public Function RTrimNull(s As String) As String
        Dim i As Integer
        i = InStr(s, vbNullChar)
        If i Then
            RTrimNull = Left$(s, i - 1)
        Else
            RTrimNull = s
        End If
    End Function
    
    Public Function ProcessID(hWndOfInterest As Long) As Long
        ' This process ID is unique to the entire application to which the window belongs.
        ' A process ID will always be unique for each running copy of an application, even if more than one copy is running.
        Call GetWindowThreadProcessId(hWndOfInterest, ProcessID)
    End Function
    
    
    
    Enjoy,
    Elroy
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  7. #7

    Thread Starter
    Fanatic Member AccessShell's Avatar
    Join Date
    Oct 2013
    Posts
    790

    Re: Closing another program

    No, No. I did not mean that the code you provided was complicated. In fact it looked quite simple. I was referring to the request. I just thought that closing another program would be simple.

  8. #8
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,817

    Re: Closing another program

    Well, different programs behave quite differently.

    For instance, I can think of this little GPower (statistical power analysis) program that I sometimes use. It only has one window for an interface, and there's really nothing to save. It does have a couple of save options, but it never complains if you don't save when exiting:

    Name:  gpower.jpg
Views: 167
Size:  56.5 KB

    And then, there are programs like my primary program, where you might have three or four windows open at any one time, and also possibly prompts about saving when they're closed.

    And there's everything in-between.

    If it's a simple program like GPower (or possibly Windows Calc), then things are easy. Just use my hWndFromPartTitle and CloseWindow procedures, and you're done. Otherwise, you need to decide exactly what you'd like to do. Sure the KillProcess will kill any program, but it's rather impolite about it.

    I'll let you decide what's best for you now.

    Take Care,
    Elroy
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width