-
Hello all.
I am trying to use VB code to close another program which is already running. I can di that using the code below labeled CODE EXAMPLE ONE. However, this does not do the job when the application which I am trying to close pops up a message box window prompting user for input "Are you sure"...
I found some code posted by Matthew Gates & it looks like what I need. However (there's that word again!), I get a runtime error 453 - can't find dll entry point when the CreateToolhelpSnapshot function is called in the code below labeled CODE EXAMPLE TWO.
Do I need a different version of kernel32.dll?
I am using VB6, NT4.0, sp6.
Any help will be greatly appreciated.
Code:
'CODE EXAMPLE ONE: ***************************************
'Module code
Option Explicit
Public Const WM_DESTROY = &H2
Public Const WM_CLOSE = &H10
Public RETURN_HANDLE As Long
Public Const TH32CS_SNAPPROCESS As Long = 2&
Public Const MAX_PATH As Long = 260
Public sAppTitle As String
Public glHwnd As Long
Public Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwflags As Long
szexeFile As String * MAX_PATH
End Type
Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
Declare Function EnumWindows Lib "user32" _
(ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Public Declare Function CreateToolhelpSnapshot Lib "c:\winnt\system32\Kernel32.dll" Alias "CreateToolhelp32Snapshot" (ByVal lFlgas As Long, ByVal lProcessID As Long) As Long
Public Declare Function ProcessFirst Lib "Kernel32" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Public Declare Function ProcessNext Lib "Kernel32" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Public Declare Sub CloseHandle Lib "Kernel32" (ByVal hPass As Long)
Public Function GetExeFromHandle(hWnd As Long) As String
Dim threadID As Long, processID As Long, hSnapshot As Long
Dim uProcess As PROCESSENTRY32, rProcessFound As Long
Dim i As Integer, szExename As String
' Get ID for window thread
threadID = GetWindowThreadProcessId(hWnd, processID)
' Check if valid
If threadID = 0 Or processID = 0 Then Exit Function
' Create snapshot of current processes
hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
' Check if snapshot is valid
If hSnapshot = -1 Then Exit Function
'Initialize uProcess with correct size
uProcess.dwSize = Len(uProcess)
'Start looping through processes
rProcessFound = ProcessFirst(hSnapshot, uProcess)
Do While rProcessFound
If uProcess.th32ProcessID = processID Then
'Found it, now get name of exefile
i = InStr(1, uProcess.szexeFile, Chr(0))
If i > 0 Then szExename = Left$(uProcess.szexeFile, i - 1)
Exit Do
Else
'Wrong ID, so continue looping
rProcessFound = ProcessNext(hSnapshot, uProcess)
End If
Loop
Call CloseHandle(hSnapshot)
GetExeFromHandle = szExename
End Function
Public Function fEnumWindowsCallBack(ByVal hWnd As Long, ByVal lpData As Long) As Long
Dim lResult As Long
Dim sWndName As String
fEnumWindowsCallBack = 1
sWndName = Space$(MAX_PATH)
lResult = GetWindowText(hWnd, sWndName, MAX_PATH)
sWndName = Left$(sWndName, lResult)
'Search Title for our string
If (InStr(1, sWndName, sAppTitle, vbTextCompare) > 0) Then
Debug.Print sWndName
glHwnd = hWnd
fEnumWindowsCallBack = 0
End If
End Function
Public Function SearchWindows(sApp As String, hWnd As Long) As Long
sAppTitle = sApp
glHwnd = 0
Call EnumWindows(AddressOf fEnumWindowsCallBack, hWnd)
SearchWindows = glHwnd
End Function
'Form code
Private Sub Command2_Click()
Dim sApp As String
'Find notepad - or name of any exe- with partial name
sApp = "note"
glHwnd = SearchWindows(sApp, Me.hWnd)
If glHwnd > 0 Then
PostMessage glHwnd, WM_CLOSE, 0&, 0&
End If
End Sub
'****************end code example one***********************
'CODE EXAMPLE TWO: ************
'NOTE - this code uses the same module declarations
'functions as the above code.
Private Sub Command2_Click()
Dim sApp As String
'Find app with partial name
sApp = "sampleAppName"
glHwnd = SearchWindows(sApp, Me.hWnd)
If glHwnd > 0 Then
RETURN_HANDLE = glHwnd
Label1.Caption = RETURN_HANDLE
End If
End Sub
Private Sub Command4_Click()
Dim exeNameStr As String
exeNameStr = GetExeFromHandle(RETURN_HANDLE)
End Sub
[Edited by Lawson on 12-06-2000 at 11:51 AM]
-
Isn't NT 16 bit?
Try changing:
user32, Kernel32
To:
user, Kernel
-
NT 4.0 is 32 bit. I made an app once which would kill an application that had the focus.
I too had trouble with the "Are you sure" type message box. I don't remember offhand how
I got rid of the messagebox - I'll see if I can dig up the project.
-
Thanks for the info!
I figured out how to shut down the application with the "Are you sure" message box. I'll post the code below. However (...that word again...), I'd still like to figure out why I am unable to access the kernel32 functions. The kernel32.dll & user32.dll exist in c:\winnt\system32 - one of the first things I checked.
Anyway, here is the code that works for me.
Code:
'MODULE PAGE:
Option Explicit
Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
Declare Function EnumWindows Lib "user32" _
(ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Declare Function CreateToolhelpSnapshot Lib "c:\winnt\system32\Kernel32.dll" Alias "CreateToolhelp32Snapshot" (ByVal lFlgas As Long, ByVal lProcessID As Long) As Long
Declare Function ProcessFirst Lib "Kernel32" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Declare Function ProcessNext Lib "Kernel32" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Declare Sub CloseHandle Lib "Kernel32" (ByVal hPass As Long)
Public Const WM_DESTROY = &H2
Public Const WM_CLOSE = &H10
Public RETURN_HANDLE As Long
Public Const TH32CS_SNAPPROCESS As Long = 2&
Public Const MAX_PATH As Long = 260
Public sAppTitle As String
Public glHwnd As Long
Public Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwflags As Long
szexeFile As String * MAX_PATH
End Type
Public Function GetExeFromHandle(hWnd As Long) As String
Dim threadID As Long, processID As Long, hSnapshot As Long
Dim uProcess As PROCESSENTRY32, rProcessFound As Long
Dim i As Integer, szExename As String
' Get ID for window thread
threadID = GetWindowThreadProcessId(hWnd, processID)
' Check if valid
If threadID = 0 Or processID = 0 Then Exit Function
' Create snapshot of current processes
hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
' Check if snapshot is valid
If hSnapshot = -1 Then Exit Function
'Initialize uProcess with correct size
uProcess.dwSize = Len(uProcess)
'Start looping through processes
rProcessFound = ProcessFirst(hSnapshot, uProcess)
Do While rProcessFound
If uProcess.th32ProcessID = processID Then
'Found it, now get name of exefile
i = InStr(1, uProcess.szexeFile, Chr(0))
If i > 0 Then szExename = Left$(uProcess.szexeFile, i - 1)
Exit Do
Else
'Wrong ID, so continue looping
rProcessFound = ProcessNext(hSnapshot, uProcess)
End If
Loop
Call CloseHandle(hSnapshot)
GetExeFromHandle = szExename
End Function
Public Function fEnumWindowsCallBack(ByVal hWnd As Long, ByVal lpData As Long) As Long
Dim lResult As Long
Dim sWndName As String
fEnumWindowsCallBack = 1
sWndName = Space$(MAX_PATH)
lResult = GetWindowText(hWnd, sWndName, MAX_PATH)
sWndName = Left$(sWndName, lResult)
'Search Title for our string
If (InStr(1, sWndName, sAppTitle, vbTextCompare) > 0) Then
Debug.Print sWndName
glHwnd = hWnd
fEnumWindowsCallBack = 0
End If
End Function
Public Function SearchWindows(sApp As String, hWnd As Long) As Long
sAppTitle = sApp
glHwnd = 0
Call EnumWindows(AddressOf fEnumWindowsCallBack, hWnd)
SearchWindows = glHwnd
End Function
'FORM:
Private Sub Command5_Click()
Dim sApp As String
'Find application running with partial name
sApp = "System Control"
glHwnd = SearchWindows(sApp, Me.hWnd)
If glHwnd > 0 Then
RETURN_HANDLE = glHwnd
Label1.Caption = RETURN_HANDLE
PostMessage glHwnd, WM_CLOSE, 0&, 0&
PostMessage glHwnd, WM_DESTROY, 0&, 0&
PostMessage glHwnd, WM_DESTROY, 0&, 0&
PostMessage glHwnd, WM_DESTROY, 0&, 0&
'this may work with only one "destroy", it
'works this way - so I left it for now
End If
End Sub
[Edited by Lawson on 12-06-2000 at 11:49 AM]
