Menutup Aplikasi Lain Berdasarkan Caption Menggunakan VB6

Mengenai cara menutup (close) aplikasi lain/luar berdasarkan caption yang ditentukan menggunakan Visual Basic 6.0 - Bagaimana kode menutup aplikasi lain menggunakan VB6 ini, bisa Anda simak kodenya di bawah ini:

Option Explicit

Private Const PROCESS_ALL_ACCESS = &H1F0FFF
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 GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wFlag 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 GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal process As Long, lpExitCode As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal process As Long, ByVal uExitCode As Long) As Long

'Code that does the work
Public Function EndApplication(ByRef caption As String, ByRef frm As Form) As Boolean
    Dim hwnd As Long
    Dim appInstance As Long
    Dim process As Long
    Dim processID
    Dim result As Boolean
    Dim exitCode As Long
    Dim returnValue As Long

    On Error GoTo Error

    If Trim(caption) = "" Then Exit Function
    Do
        hwnd = FindWindowByTitle(caption, frm)
        If hwnd = 0 Then Exit Do
        appInstance = GetWindowThreadProcessId(hwnd, processID)
        'Get a handle for the process we're looking for
        process = OpenProcess(PROCESS_ALL_ACCESS, 0&, processID)
        If process <> 0 Then
            'Next get our exit code (for use later)
            GetExitCodeProcess process, exitCode
                'Check for an exit code of 9 (zero)
                If exitCode <> 0 Then
                     'It's not zero so close the window
                    returnValue = TerminateProcess(process, exitCode)
                    If result = False Then result = returnValue > 0
                End If
        End If
    Loop
    EndApplication = result
Error:
'    MsgBox (Err.Number & ": " & Err.Description)
End Function

Private Function FindWindowByTitle(ByRef str As String, ByRef frm As Form) As Long
    Dim handle As Long
    Dim caption As String
    Dim sTitle As String

    handle = frm.hwnd
    sTitle = LCase(str)
    Do
       DoEvents
          If handle = 0 Then Exit Do
            caption = LCase$(GetWindowCaption(handle))

           If InStr(caption, sTitle) Then
              FindWindowByTitle = handle
              Exit Do
           Else
             FindWindowByTitle = 0
           End If
           handle = GetNextWindow(handle, 2)
    Loop
End Function

Private Function GetWindowCaption(ByRef handle As Long) As String
    Dim str As String
    Dim length As Long

    length& = GetWindowTextLength(handle)
    str = String(length, 0)
    Call GetWindowText(handle, str, length + 1)
    GetWindowCaption = str
End Function

Contoh penggunaan kode di atas:

Private Sub Command1_Click()
    Shell "Regedit", vbNormalFocus 'membuka regedit.exe
End Sub

Private Sub Command2_Click()
    EndApplication "Registry Editor", Me 'menutup regedit.exe yang memiliki caption 'Registry Editor'
End Sub