renz2003
asked on
VB resist termination
How does visual basic handle atexit (atexit is in c?) command? I have a program that basically should resist being terminated by any other running processes, in other words, it should always run, it should never be exited. (like a daemon thing) can you give me some few pointers and or tips maybe? thanks.
For Win9X use comment from rdrunner and the following.
Public Declare Function RegisterServiceProcess Lib "kernel32" (ByVal hProcess As Long, ByVal lType As Long) As Long
Public Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Sub HideAppFromTaskManager()
On Error GoTo Error_Handler:
RegisterServiceProcess GetCurrentProcessId(), 1 ' // Hides from the task Manager 1 its the hide property
End sub
Public Declare Function RegisterServiceProcess Lib "kernel32" (ByVal hProcess As Long, ByVal lType As Long) As Long
Public Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Sub HideAppFromTaskManager()
On Error GoTo Error_Handler:
RegisterServiceProcess GetCurrentProcessId(), 1 ' // Hides from the task Manager 1 its the hide property
End sub
ASKER
You can goto the "querryUnload" event of the main form and just set cancel = true
This wont allow the form to be terminated (unless extreme force is used)
yes, thats true rdrunner but if the user should press ctrl+alt+del? the program will terminate immediately. thank you, by the way
This wont allow the form to be terminated (unless extreme force is used)
yes, thats true rdrunner but if the user should press ctrl+alt+del? the program will terminate immediately. thank you, by the way
ASKER
yeah timw1, i did that too. the program is typically hidden from the taskmanager. But there would be a way werein the program would also be exited =( .Another program like that of
http://msdn.microsoft.com/archive/default.asp?url=/archive/en-us/dnarvbtips/html/msdn_msdn36.asp would make the program too vulnerable =(
when the user knows the name of the application, walah! the program dies.
would it be a good idea also if there will be an external program that monitors my program that when if it dies, all the external program will do is just to do a shellexecute thing and execute the program again? thanks a lot =)
http://msdn.microsoft.com/archive/default.asp?url=/archive/en-us/dnarvbtips/html/msdn_msdn36.asp would make the program too vulnerable =(
when the user knows the name of the application, walah! the program dies.
would it be a good idea also if there will be an external program that monitors my program that when if it dies, all the external program will do is just to do a shellexecute thing and execute the program again? thanks a lot =)
Well then you could create a loader app. It will enumerate all running processes, check that the process name of your app is not in the list then shell it. However you will have the same problem with the loader wont you?
I will paste in a bas module I was playing with ages ago. You will need to add a form and work through the loadtasklist() function. It will save you time. Note this code tries to streamline the list to just applications and ignore OS processes.
-------- Sorry, its quite a lot of code ---------------
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function EnumDesktopWindows Lib "user32" (ByVal hDesktop As Long, ByVal lpfn As Long, ByVal lParam As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long
Private Declare Function GetConsoleTitle Lib "kernel32" Alias "GetConsoleTitleA" (ByVal lpConsoleTitle As String, ByVal nSize As Long) As Long
Private 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
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Const GWL_HINSTANCE = (-6)
Private Const WM_CLOSE = &H10
Private Const GWL_WNDPROC = (-4)
Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, _
lpRect As RECT) As Long
Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, _
ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function EnumWindows Lib "user32" _
(ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent _
As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function EnumThreadWindows Lib "user32" (ByVal dwThreadId _
As Long, ByVal lpfn As Long, ByVal lParam As Long) As Long
Declare Function GetWindowThreadProcessId Lib "user32" _
(ByVal hwnd As Long, lpdwProcessId As Long) As Long
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hwnd As Long, ByVal lpClassName As String, _
ByVal nMaxCount 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
Private Const GW_HWNDFIRST = 0
Private Const GW_HWNDLAST = 1
Private Const GW_HWNDNEXT = 2
Private Const GW_HWNDPREV = 3
Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long
Declare Function IsWindowUnicode Lib "user32" (ByVal hwnd As Long) As Long
Declare Function IsWindowEnabled Lib "user32" (ByVal hwnd As Long) As Long
Declare Function IsZoomed Lib "user32" (ByVal hwnd As _
Long) As Long
Declare Function IsIconic Lib "user32" (ByVal hwnd _
As Long) As Long
Declare Function IsChild Lib "user32" (ByVal hWndParent As Long, ByVal hwnd As Long) As Long
Public TopCount As Integer ' Number of Top level Windows
Public ChildCount As Integer ' Number of Child Windows
Public ThreadCount As Integer ' Number of Thread Windows
Public Const GW_CHILD = 5
Const SW_MINIMIZE = 6
Const WM_SYSCOMMAND = &H112&
Const SC_SCREENSAVE = &HF140&
Const SC_SIZE As Long = &HF000&
Const SC_SEPARATOR As Long = &HF00F&
Const SC_MOVE As Long = &HF010&
Const SC_MINIMIZE As Long = &HF020&
Const SC_MAXIMIZE As Long = &HF030&
Const SC_CLOSE As Long = &HF060&
Const SC_RESTORE As Long = &HF120&
Global Const SW_SHOWNORMAL = 1
Global Const SW_SHOWMINIMIZED = 2
Global Const SW_SHOWMAXIMIZED = 3
Public Const WS_MINIMIZE = &H20000000
Public Const WS_MAXIMIZE = &H1000000
Option Explicit
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'const for setwindowlong
'Public Declare Function EnumWindows Lib "user32" _
' (ByVal lpEnumFunc As Any, ByVal lParam As Any) As Long
'Public Declare Function GetWindowText Lib "user32" _
' Alias "GetWindowTextA" _
' (ByVal hwnd As Long, _
' ByVal lpString As String, _
' ByVal cch As Long) As Long
'CDROM
'Declare Function alias_mciSendString& Lib "MMSystem.dll" Alias "mciSendString" (ByVal Sound$, ByVal RtnString$, ByVal RtnLength%, ByVal Hndl%)
Function WndEnumProc(ByVal hwnd As Long) As Long
Dim szTitle As String
Dim bRet As Long
Dim result As Long
szTitle = String(512, 0)
bRet = GetWindowText(hwnd, szTitle, 512)
'only show those that have titles
If (bRet <> 0) Then
'minimize the window by the handle
If IsWindowVisible(hwnd) Then
If IsWindow(hwnd) Then
result = ShowWindow(hwnd, SW_MINIMIZE)
End If
End If
End If
WndEnumProc = 1
'Dim bRet As Long
'bRet = EnumWindows(AddressOf WndEnumProc, lstOutput)
'These call this function
End Function
Sub LoadTaskList()
On Error GoTo ErrorRoutineErr
Dim CurrWnd As Long
Dim Length As Long
Dim TaskName As String
Dim Parent As Long
'List1.Clear
CurrWnd = GetWindow(Form1.hwnd, GW_HWNDFIRST)
'Add tasks to the listbox
While CurrWnd <> 0
Parent = GetParent(CurrWnd)
Length = GetWindowTextLength(CurrWn
TaskName = Space$(Length + 1)
Length = GetWindowText(CurrWnd, TaskName, Length + 1)
TaskName = Left$(TaskName, Len(TaskName) - 1)
If Length > 0 Then
If TaskName <> Me.Caption Then
List1.AddItem TaskName & Chr(9) & Chr(9) & CurrWnd
End If
End If
CurrWnd = GetWindow(CurrWnd, GW_HWNDNEXT)
DoEvents
Wend
ErrorRoutineResume:
Exit Sub
ErrorRoutineErr:
MsgBox "AppShell.Form1.LoadTaskLi
Resume Next
End Sub
Private Sub EnumWinProc2()
Dim lRet As Long, lParam As Long
Dim lhWnd As Long
Dim hwnd As Long
'lhWnd = Me.hWnd ' Find the Form's Child Windows
' Comment the line above and uncomment the line below to
'enumerate Windows for the DeskTop rather than for the Form
lhWnd = GetDesktopWindow() ' Find the Desktop's Child Windows
' enumerate the list
lRet = EnumChildWindows(lhWnd, AddressOf EnumChildProc, lParam)
hwnd = GetWindow(lhWnd, GW_CHILD)
End Sub
Function EnumWinProc(ByVal lhWnd As Long, ByVal lParam As Long) _
As Long
Dim RetVal As Long, ProcessID As Long, ThreadID As Long
Dim WinClassBuf As String * 255, WinTitleBuf As String * 255
Dim WinClass As String, WinTitle As String
RetVal = GetClassName(lhWnd, WinClassBuf, 255)
WinClass = StripNulls(WinClassBuf) ' remove extra Nulls & spaces
RetVal = GetWindowText(lhWnd, WinTitleBuf, 255)
WinTitle = StripNulls(WinTitleBuf)
TopCount = TopCount + 1
' see the Windows Class and Title for each top level Window
Debug.Print "Top level Class = "; WinClass; ", Title = "; WinTitle
' Usually either enumerate Child or Thread Windows, not both.
' In this example, EnumThreadWindows may produce a very long list!
RetVal = EnumChildWindows(lhWnd, AddressOf EnumChildProc, lParam)
' ThreadID = GetWindowThreadProcessId(l
'RetVal = EnumThreadWindows(ThreadID
lParam)
EnumWinProc = True
End Function
Function EnumChildProc(ByVal lhWnd As Long, ByVal lParam As Long) _
As Long
Dim RetVal As Long
Dim WinClassBuf As String * 255, WinTitleBuf As String * 255
Dim WinClass As String, WinTitle As String
Dim WinRect As RECT
Dim WinWidth As Long, WinHeight As Long
RetVal = GetClassName(lhWnd, WinClassBuf, 255)
WinClass = StripNulls(WinClassBuf) ' remove extra Nulls & spaces
RetVal = GetWindowText(lhWnd, WinTitleBuf, 255)
WinTitle = StripNulls(WinTitleBuf)
ChildCount = ChildCount + 1
' see the Windows Class and Title for each Child Window enumerated
Debug.Print " Handle = " & lhWnd & " Child Class = "; WinClass; ", Title = "; WinTitle
' You can find any type of Window by searching for its WinClass
If WinClass = "ThunderTextBox" Then ' TextBox Window
RetVal = GetWindowRect(lhWnd, WinRect) ' get current size
WinWidth = WinRect.Right - WinRect.Left ' keep current width
WinHeight = (WinRect.Bottom - WinRect.Top) * 2 ' double height
RetVal = MoveWindow(lhWnd, 0, 0, WinWidth, WinHeight, True)
EnumChildProc = False
Else
EnumChildProc = True
End If
End Function
Function EnumThreadProc(ByVal lhWnd As Long, ByVal lParam As Long) _
As Long
Dim RetVal As Long
Dim WinClassBuf As String * 255, WinTitleBuf As String * 255
Dim WinClass As String, WinTitle As String
RetVal = GetClassName(lhWnd, WinClassBuf, 255)
WinClass = StripNulls(WinClassBuf) ' remove extra Nulls & spaces
RetVal = GetWindowText(lhWnd, WinTitleBuf, 255)
WinTitle = StripNulls(WinTitleBuf)
ThreadCount = ThreadCount + 1
' see the Windows Class and Title for top level Window
Debug.Print "Thread Window Class = "; WinClass; ", Title = "; _
WinTitle
EnumThreadProc = True
End Function
Public Function StripNulls(OriginalStr As String) As String
' This removes the extra Nulls so String comparisons will work
If (InStr(OriginalStr, Chr(0)) > 0) Then
OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
End If
StripNulls = OriginalStr
End Function
Sub StartEnumerate()
Dim lRet As Long
Dim lParam As Long
Dim WinTitleBuf As String
'Dim lret2 As Boolean
'enumerate the list
lRet = EnumWindows(AddressOf EnumWinProc2, lParam)
'If GetWindowText(lRet, WinTitleBuf, 255) <> 0 Then
If GetWindowText(lRet, WinTitleBuf, 255) <> 0 Then
' How many Windows did we find?
Debug.Print TopCount; " Total Top level Windows"
Debug.Print ChildCount; " Total Child Windows"
Debug.Print ThreadCount; " Total Thread Windows"
Debug.Print "For a grand total of "; TopCount + _
ChildCount + ThreadCount; " Windows!"
End If
End Sub
Public Function CloseAllProcesses() As Variant
Dim CurrWnd As Long
Dim Length As Long
Dim TaskName As String
Dim Parent As Long
Dim clsWinDetails As New WindowDetails
Dim tmpWindow As WindowDetail
Dim ActiveWindow As Long, strActiveWindowTitle As String
'List1.Clear
ActiveWindow = GetActiveWindow()
Length = GetWindowTextLength(Active
TaskName = Space$(Length + 1)
Length = GetWindowText(ActiveWindow
TaskName = Left$(TaskName, Len(TaskName) - 1)
strActiveWindowTitle = TaskName
CurrWnd = GetWindow(GetActiveWindow,
'Add tasks to the listbox
While CurrWnd <> 0
NextWindow:
Parent = GetParent(CurrWnd)
If Parent <> 0 Then
For Each tmpWindow In clsWinDetails
If tmpWindow.hwnd = Parent Then
CurrWnd = GetWindow(CurrWnd, GW_HWNDNEXT)
GoTo NextWindow:
End If
Next
End If
Length = GetWindowTextLength(CurrWn
TaskName = Space$(Length + 1)
Length = GetWindowText(CurrWnd, TaskName, Length + 1)
TaskName = Left$(TaskName, Len(TaskName) - 1)
If Length > 0 Then
If Parent = 0 Then
Debug.Print CurrWnd & " " & TaskName
If IsWindowVisible(CurrWnd) <> 0 And IsWindow(CurrWnd) <> 0 Then
For Each tmpWindow In clsWinDetails
If tmpWindow.hwnd = CurrWnd Then
CurrWnd = GetWindow(CurrWnd, GW_HWNDNEXT)
GoTo NextWindow:
End If
Next
clsWinDetails.Add hwnd:=CurrWnd, Title:=TaskName, sKey:=CStr(CurrWnd), ShutDownIssued:=False
Debug.Print CurrWnd & " " & TaskName
End If
End If
End If
CurrWnd = GetWindow(CurrWnd, GW_HWNDNEXT)
DoEvents
Wend
'MsgBox "Finished"
Dim Count
For Each tmpWindow In clsWinDetails
If tmpWindow.Title <> "Program Manager" And tmpWindow.hwnd <> ActiveWindow And tmpWindow.Title <> strActiveWindowTitle Then
tmpWindow.ShutDownIssued = True
If IsWindow(tmpWindow.hwnd) <> 0 Then
PostMessage tmpWindow.hwnd, WM_CLOSE, False, 0
End If
Else
clsWinDetails.Remove CStr(tmpWindow.hwnd)
End If
Next
'All Windows to be closed have had command issued
'Check that windows have closed
'Remove window that have closed from collection
'Return collection for further action
For Each tmpWindow In clsWinDetails
If tmpWindow.ShutDownIssued = True Then
If tmpWindow.Title <> "Program Manager" And tmpWindow.hwnd <> ActiveWindow And tmpWindow.Title <> strActiveWindowTitle Then
If IsWindow(tmpWindow.hwnd) = 0 Then
clsWinDetails.Remove CStr(tmpWindow.hwnd)
End If
End If
End If
Next
If clsWinDetails.Count > 0 Then
Dim strMSG
strMSG = "Some Windows did not close. Do you want to Terminate them?"
If MsgBox(strMSG, vbYesNo, "Terminate Windows?") = vbNo Then GoTo exit_Function:
End If
'Now Terminate unclosed Windows
For Each tmpWindow In clsWinDetails
If tmpWindow.ShutDownIssued = True Then
If tmpWindow.Title <> "Program Manager" And tmpWindow.hwnd <> ActiveWindow Then
If IsWindow(tmpWindow.hwnd) <> 0 Then
'Get the Process handle
'hProcess = GetWindowLong(tmpWindow.hw
PostMessage tmpWindow.hwnd, WM_CLOSE, False, 0
Else
clsWinDetails.Remove CStr(tmpWindow.hwnd)
End If
End If
End If
Next
Set CloseAllProcesses = clsWinDetails
exit_Function:
Set clsWinDetails = Nothing
End Function
I will paste in a bas module I was playing with ages ago. You will need to add a form and work through the loadtasklist() function. It will save you time. Note this code tries to streamline the list to just applications and ignore OS processes.
-------- Sorry, its quite a lot of code ---------------
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function EnumDesktopWindows Lib "user32" (ByVal hDesktop As Long, ByVal lpfn As Long, ByVal lParam As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long
Private Declare Function GetConsoleTitle Lib "kernel32" Alias "GetConsoleTitleA" (ByVal lpConsoleTitle As String, ByVal nSize As Long) As Long
Private 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
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Const GWL_HINSTANCE = (-6)
Private Const WM_CLOSE = &H10
Private Const GWL_WNDPROC = (-4)
Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, _
lpRect As RECT) As Long
Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, _
ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function EnumWindows Lib "user32" _
(ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent _
As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function EnumThreadWindows Lib "user32" (ByVal dwThreadId _
As Long, ByVal lpfn As Long, ByVal lParam As Long) As Long
Declare Function GetWindowThreadProcessId Lib "user32" _
(ByVal hwnd As Long, lpdwProcessId As Long) As Long
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hwnd As Long, ByVal lpClassName As String, _
ByVal nMaxCount 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
Private Const GW_HWNDFIRST = 0
Private Const GW_HWNDLAST = 1
Private Const GW_HWNDNEXT = 2
Private Const GW_HWNDPREV = 3
Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long
Declare Function IsWindowUnicode Lib "user32" (ByVal hwnd As Long) As Long
Declare Function IsWindowEnabled Lib "user32" (ByVal hwnd As Long) As Long
Declare Function IsZoomed Lib "user32" (ByVal hwnd As _
Long) As Long
Declare Function IsIconic Lib "user32" (ByVal hwnd _
As Long) As Long
Declare Function IsChild Lib "user32" (ByVal hWndParent As Long, ByVal hwnd As Long) As Long
Public TopCount As Integer ' Number of Top level Windows
Public ChildCount As Integer ' Number of Child Windows
Public ThreadCount As Integer ' Number of Thread Windows
Public Const GW_CHILD = 5
Const SW_MINIMIZE = 6
Const WM_SYSCOMMAND = &H112&
Const SC_SCREENSAVE = &HF140&
Const SC_SIZE As Long = &HF000&
Const SC_SEPARATOR As Long = &HF00F&
Const SC_MOVE As Long = &HF010&
Const SC_MINIMIZE As Long = &HF020&
Const SC_MAXIMIZE As Long = &HF030&
Const SC_CLOSE As Long = &HF060&
Const SC_RESTORE As Long = &HF120&
Global Const SW_SHOWNORMAL = 1
Global Const SW_SHOWMINIMIZED = 2
Global Const SW_SHOWMAXIMIZED = 3
Public Const WS_MINIMIZE = &H20000000
Public Const WS_MAXIMIZE = &H1000000
Option Explicit
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'const for setwindowlong
'Public Declare Function EnumWindows Lib "user32" _
' (ByVal lpEnumFunc As Any, ByVal lParam As Any) As Long
'Public Declare Function GetWindowText Lib "user32" _
' Alias "GetWindowTextA" _
' (ByVal hwnd As Long, _
' ByVal lpString As String, _
' ByVal cch As Long) As Long
'CDROM
'Declare Function alias_mciSendString& Lib "MMSystem.dll" Alias "mciSendString" (ByVal Sound$, ByVal RtnString$, ByVal RtnLength%, ByVal Hndl%)
Function WndEnumProc(ByVal hwnd As Long) As Long
Dim szTitle As String
Dim bRet As Long
Dim result As Long
szTitle = String(512, 0)
bRet = GetWindowText(hwnd, szTitle, 512)
'only show those that have titles
If (bRet <> 0) Then
'minimize the window by the handle
If IsWindowVisible(hwnd) Then
If IsWindow(hwnd) Then
result = ShowWindow(hwnd, SW_MINIMIZE)
End If
End If
End If
WndEnumProc = 1
'Dim bRet As Long
'bRet = EnumWindows(AddressOf WndEnumProc, lstOutput)
'These call this function
End Function
Sub LoadTaskList()
On Error GoTo ErrorRoutineErr
Dim CurrWnd As Long
Dim Length As Long
Dim TaskName As String
Dim Parent As Long
'List1.Clear
CurrWnd = GetWindow(Form1.hwnd, GW_HWNDFIRST)
'Add tasks to the listbox
While CurrWnd <> 0
Parent = GetParent(CurrWnd)
Length = GetWindowTextLength(CurrWn
TaskName = Space$(Length + 1)
Length = GetWindowText(CurrWnd, TaskName, Length + 1)
TaskName = Left$(TaskName, Len(TaskName) - 1)
If Length > 0 Then
If TaskName <> Me.Caption Then
List1.AddItem TaskName & Chr(9) & Chr(9) & CurrWnd
End If
End If
CurrWnd = GetWindow(CurrWnd, GW_HWNDNEXT)
DoEvents
Wend
ErrorRoutineResume:
Exit Sub
ErrorRoutineErr:
MsgBox "AppShell.Form1.LoadTaskLi
Resume Next
End Sub
Private Sub EnumWinProc2()
Dim lRet As Long, lParam As Long
Dim lhWnd As Long
Dim hwnd As Long
'lhWnd = Me.hWnd ' Find the Form's Child Windows
' Comment the line above and uncomment the line below to
'enumerate Windows for the DeskTop rather than for the Form
lhWnd = GetDesktopWindow() ' Find the Desktop's Child Windows
' enumerate the list
lRet = EnumChildWindows(lhWnd, AddressOf EnumChildProc, lParam)
hwnd = GetWindow(lhWnd, GW_CHILD)
End Sub
Function EnumWinProc(ByVal lhWnd As Long, ByVal lParam As Long) _
As Long
Dim RetVal As Long, ProcessID As Long, ThreadID As Long
Dim WinClassBuf As String * 255, WinTitleBuf As String * 255
Dim WinClass As String, WinTitle As String
RetVal = GetClassName(lhWnd, WinClassBuf, 255)
WinClass = StripNulls(WinClassBuf) ' remove extra Nulls & spaces
RetVal = GetWindowText(lhWnd, WinTitleBuf, 255)
WinTitle = StripNulls(WinTitleBuf)
TopCount = TopCount + 1
' see the Windows Class and Title for each top level Window
Debug.Print "Top level Class = "; WinClass; ", Title = "; WinTitle
' Usually either enumerate Child or Thread Windows, not both.
' In this example, EnumThreadWindows may produce a very long list!
RetVal = EnumChildWindows(lhWnd, AddressOf EnumChildProc, lParam)
' ThreadID = GetWindowThreadProcessId(l
'RetVal = EnumThreadWindows(ThreadID
lParam)
EnumWinProc = True
End Function
Function EnumChildProc(ByVal lhWnd As Long, ByVal lParam As Long) _
As Long
Dim RetVal As Long
Dim WinClassBuf As String * 255, WinTitleBuf As String * 255
Dim WinClass As String, WinTitle As String
Dim WinRect As RECT
Dim WinWidth As Long, WinHeight As Long
RetVal = GetClassName(lhWnd, WinClassBuf, 255)
WinClass = StripNulls(WinClassBuf) ' remove extra Nulls & spaces
RetVal = GetWindowText(lhWnd, WinTitleBuf, 255)
WinTitle = StripNulls(WinTitleBuf)
ChildCount = ChildCount + 1
' see the Windows Class and Title for each Child Window enumerated
Debug.Print " Handle = " & lhWnd & " Child Class = "; WinClass; ", Title = "; WinTitle
' You can find any type of Window by searching for its WinClass
If WinClass = "ThunderTextBox" Then ' TextBox Window
RetVal = GetWindowRect(lhWnd, WinRect) ' get current size
WinWidth = WinRect.Right - WinRect.Left ' keep current width
WinHeight = (WinRect.Bottom - WinRect.Top) * 2 ' double height
RetVal = MoveWindow(lhWnd, 0, 0, WinWidth, WinHeight, True)
EnumChildProc = False
Else
EnumChildProc = True
End If
End Function
Function EnumThreadProc(ByVal lhWnd As Long, ByVal lParam As Long) _
As Long
Dim RetVal As Long
Dim WinClassBuf As String * 255, WinTitleBuf As String * 255
Dim WinClass As String, WinTitle As String
RetVal = GetClassName(lhWnd, WinClassBuf, 255)
WinClass = StripNulls(WinClassBuf) ' remove extra Nulls & spaces
RetVal = GetWindowText(lhWnd, WinTitleBuf, 255)
WinTitle = StripNulls(WinTitleBuf)
ThreadCount = ThreadCount + 1
' see the Windows Class and Title for top level Window
Debug.Print "Thread Window Class = "; WinClass; ", Title = "; _
WinTitle
EnumThreadProc = True
End Function
Public Function StripNulls(OriginalStr As String) As String
' This removes the extra Nulls so String comparisons will work
If (InStr(OriginalStr, Chr(0)) > 0) Then
OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
End If
StripNulls = OriginalStr
End Function
Sub StartEnumerate()
Dim lRet As Long
Dim lParam As Long
Dim WinTitleBuf As String
'Dim lret2 As Boolean
'enumerate the list
lRet = EnumWindows(AddressOf EnumWinProc2, lParam)
'If GetWindowText(lRet, WinTitleBuf, 255) <> 0 Then
If GetWindowText(lRet, WinTitleBuf, 255) <> 0 Then
' How many Windows did we find?
Debug.Print TopCount; " Total Top level Windows"
Debug.Print ChildCount; " Total Child Windows"
Debug.Print ThreadCount; " Total Thread Windows"
Debug.Print "For a grand total of "; TopCount + _
ChildCount + ThreadCount; " Windows!"
End If
End Sub
Public Function CloseAllProcesses() As Variant
Dim CurrWnd As Long
Dim Length As Long
Dim TaskName As String
Dim Parent As Long
Dim clsWinDetails As New WindowDetails
Dim tmpWindow As WindowDetail
Dim ActiveWindow As Long, strActiveWindowTitle As String
'List1.Clear
ActiveWindow = GetActiveWindow()
Length = GetWindowTextLength(Active
TaskName = Space$(Length + 1)
Length = GetWindowText(ActiveWindow
TaskName = Left$(TaskName, Len(TaskName) - 1)
strActiveWindowTitle = TaskName
CurrWnd = GetWindow(GetActiveWindow,
'Add tasks to the listbox
While CurrWnd <> 0
NextWindow:
Parent = GetParent(CurrWnd)
If Parent <> 0 Then
For Each tmpWindow In clsWinDetails
If tmpWindow.hwnd = Parent Then
CurrWnd = GetWindow(CurrWnd, GW_HWNDNEXT)
GoTo NextWindow:
End If
Next
End If
Length = GetWindowTextLength(CurrWn
TaskName = Space$(Length + 1)
Length = GetWindowText(CurrWnd, TaskName, Length + 1)
TaskName = Left$(TaskName, Len(TaskName) - 1)
If Length > 0 Then
If Parent = 0 Then
Debug.Print CurrWnd & " " & TaskName
If IsWindowVisible(CurrWnd) <> 0 And IsWindow(CurrWnd) <> 0 Then
For Each tmpWindow In clsWinDetails
If tmpWindow.hwnd = CurrWnd Then
CurrWnd = GetWindow(CurrWnd, GW_HWNDNEXT)
GoTo NextWindow:
End If
Next
clsWinDetails.Add hwnd:=CurrWnd, Title:=TaskName, sKey:=CStr(CurrWnd), ShutDownIssued:=False
Debug.Print CurrWnd & " " & TaskName
End If
End If
End If
CurrWnd = GetWindow(CurrWnd, GW_HWNDNEXT)
DoEvents
Wend
'MsgBox "Finished"
Dim Count
For Each tmpWindow In clsWinDetails
If tmpWindow.Title <> "Program Manager" And tmpWindow.hwnd <> ActiveWindow And tmpWindow.Title <> strActiveWindowTitle Then
tmpWindow.ShutDownIssued = True
If IsWindow(tmpWindow.hwnd) <> 0 Then
PostMessage tmpWindow.hwnd, WM_CLOSE, False, 0
End If
Else
clsWinDetails.Remove CStr(tmpWindow.hwnd)
End If
Next
'All Windows to be closed have had command issued
'Check that windows have closed
'Remove window that have closed from collection
'Return collection for further action
For Each tmpWindow In clsWinDetails
If tmpWindow.ShutDownIssued = True Then
If tmpWindow.Title <> "Program Manager" And tmpWindow.hwnd <> ActiveWindow And tmpWindow.Title <> strActiveWindowTitle Then
If IsWindow(tmpWindow.hwnd) = 0 Then
clsWinDetails.Remove CStr(tmpWindow.hwnd)
End If
End If
End If
Next
If clsWinDetails.Count > 0 Then
Dim strMSG
strMSG = "Some Windows did not close. Do you want to Terminate them?"
If MsgBox(strMSG, vbYesNo, "Terminate Windows?") = vbNo Then GoTo exit_Function:
End If
'Now Terminate unclosed Windows
For Each tmpWindow In clsWinDetails
If tmpWindow.ShutDownIssued = True Then
If tmpWindow.Title <> "Program Manager" And tmpWindow.hwnd <> ActiveWindow Then
If IsWindow(tmpWindow.hwnd) <> 0 Then
'Get the Process handle
'hProcess = GetWindowLong(tmpWindow.hw
PostMessage tmpWindow.hwnd, WM_CLOSE, False, 0
Else
clsWinDetails.Remove CStr(tmpWindow.hwnd)
End If
End If
End If
Next
Set CloseAllProcesses = clsWinDetails
exit_Function:
Set clsWinDetails = Nothing
End Function
ASKER
hello timw1,
that is quite some code you got there =) thanks, but i do need to get things straighten out first, since i won't be able to cut and paste your code from now, (too busy) i will maybe in the next couple of days from now.
i noticed from your code above that you have used WM_CLOSE. how do you catch this wm_close before it goes into your program and tries to kill your program? maybe i need this wm_close thing and not the external program... do you know how to?
thank you very much timw1
that is quite some code you got there =) thanks, but i do need to get things straighten out first, since i won't be able to cut and paste your code from now, (too busy) i will maybe in the next couple of days from now.
i noticed from your code above that you have used WM_CLOSE. how do you catch this wm_close before it goes into your program and tries to kill your program? maybe i need this wm_close thing and not the external program... do you know how to?
thank you very much timw1
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
The code for this was originally from:
' Centrdlg sample from BlackBeltVB.com
' http://blackbeltvb.com
Credit goes to: ' Written by Matt Hart
' Copyright 1999 by Matt Hart
Please Note: This is a modified version. Matt asked that references to this code be directed to:
http://blackbeltvb.com/centrdlg.htm
However, the link does not exist at this time so I will post my modified version of it.
There is one dependancy for this module. (IsWin2korXP) you can create your own function to do this if you need to.
' Centrdlg sample from BlackBeltVB.com
' http://blackbeltvb.com
'
' Written by Matt Hart
' Copyright 1999 by Matt Hart
'
' This software is FREEWARE. You may use it as you see fit for
' your own projects but you may not re-sell the original or the
' source code. Do not copy this sample to a collection, such as
' a CD-ROM archive. You may link directly to the original sample
' using "http://blackbeltvb.com/centrdlg.htm"
'
' No warranty express or implied, is given as to the use of this
' program. Use at your own risk.
Option Explicit
Type CWPSTRUCT
lParam As Long
wParam As Long
message As Long
hwnd As Long
End Type
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Const WH_CALLWNDPROC = 4
Public Const GWL_WNDPROC = (-4)
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOACTIVATE = &H10
Private Const WM_QUERYENDSESSION = &H11
Private Const WM_ENDSESSION = &H16
Private Const ENDSESSION_LOGOFF = &H80000000
Public lWndProc As Long
Public hHook As Long, lHookWndProc As Long
'Private Enum WindowMessages
' WM_ACTIVATE = &H6
' WM_ACTIVATEAPP = &H1C
' WM_ASKCBFORMATNAME = &H30C
' WM_CANCELJOURNAL = &H4B
' WM_CANCELMODE = &H1F
' WM_CAPTURECHANGED = &H1F
' WM_CAPTURECHANGED_R = &H215
' WM_CHANGECBCHAIN = &H30D
' WM_CHAR = &H102
' WM_CHARTOITEM = &H2F
' WM_CHILDACTIVATE = &H22
' WM_CHOOSEFONT_GETLOGFONT = &H401
' WM_CHOOSEFONT_SETFLAGS = (&H400 + 102)
' WM_CHOOSEFONT_SETLOGFONT = (&H400 + 101)
' WM_CLEAR = &H303
' WM_CLOSE = &H10
' WM_COMMAND = &H111
' WM_COMPACTING = &H41
' WM_COMPAREITEM = &H39
' WM_CONTEXTMENU = &H7B
' WM_CONVERTREQUESTEX = &H108
' WM_COPY = &H301
' WM_COPYDATA = &H4A
' WM_CREATE = &H1
' WM_CTLCOLORBTN = &H135
' WM_CTLCOLORDLG = &H136
' WM_CTLCOLOREDIT = &H133
' WM_CTLCOLORLISTBOX = &H134
' WM_CTLCOLORMSGBOX = &H132
' WM_CTLCOLORSCROLLBAR = &H137
' WM_CTLCOLORSTATIC = &H138
' WM_CUT = &H300
' WM_DDE_ACK = (&H3E0 + 4)
' WM_DDE_ADVISE = (&H3E0 + 2)
' WM_DDE_DATA = (&H3E0 + 5)
' WM_DDE_EXECUTE = (&H3E0 + 8)
' WM_DDE_FIRST = &H3E0
' WM_DDE_INITIATE = &H3E0
' WM_DDE_LAST = (&H3E0 + 8)
' WM_DDE_POKE = (&H3E0 + 7)
' WM_DDE_REQUEST = (&H3E0 + 6)
' WM_DDE_TERMINATE = (&H3E0 + 1)
' WM_DDE_UNADVISE = (&H3E0 + 3)
' WM_DEADCHAR = &H103
' WM_DELETEITEM = &H2D
' WM_DESTROY = &H2
' WM_DESTROYCLIPBOARD = &H307
' WM_DEVICECHANGE = &H219
' WM_DEVMODECHANGE = &H1B
' WM_DRAWCLIPBOARD = &H308
' WM_DRAWITEM = &H2B
' WM_DROPFILES = &H233
' WM_ENABLE = &HA
' WM_ENDSESSION = &H16
' WM_ENTERIDLE = &H121
' WM_ENTERSIZEMOVE = &H231
' WM_ENTERMENULOOP = &H211
' WM_ERASEBKGND = &H14
' WM_EXITMENULOOP = &H212
' WM_EXITSIZEMOVE = &H232
' WM_FONTCHANGE = &H1D
' WM_GETDLGCODE = &H87
' WM_GETFONT = &H31
' WM_GETHOTKEY = &H33
' WM_GETMINMAXINFO = &H24
' WM_GETTEXT = &HD
' WM_GETTEXTLENGTH = &HE
' WM_HOTKEY = &H312
' WM_HSCROLL = &H114
' WM_HSCROLLCLIPBOARD = &H30E
' WM_ICONERASEBKGND = &H27
' WM_IME_CHAR = &H286
' WM_IME_COMPOSITION = &H10F
' WM_IME_COMPOSITIONFULL = &H284
' WM_IME_CONTROL = &H283
' WM_IME_ENDCOMPOSITION = &H10E
' WM_IME_KEYDOWN = &H290
' WM_IME_KEYLAST = &H10F
' WM_IME_KEYUP = &H291
' WM_IME_NOTIFY = &H282
' WM_IME_SELECT = &H285
' WM_IME_SETCONTEXT = &H281
' WM_IME_STARTCOMPOSITION = &H10D
' WM_INITDIALOG = &H110
' WM_INITMENU = &H116
' WM_INITMENUPOPUP = &H117
' WM_INPUTLANGCHANGEREQUEST = &H50
' WM_INPUTLANGCHANGE = &H51
' WM_KEYDOWN = &H100
' WM_KEYUP = &H101
' WM_KILLFOCUS = &H8
' WM_LBUTTONDBLCLK = &H203
' WM_LBUTTONDOWN = &H201
' WM_LBUTTONUP = &H202
' WM_MBUTTONDBLCLK = &H209
' WM_MBUTTONDOWN = &H207
' WM_MBUTTONUP = &H208
' WM_MDIACTIVATE = &H222
' WM_MDICASCADE = &H227
' WM_MDICREATE = &H220
' WM_MDIDESTROY = &H221
' WM_MDIGETACTIVE = &H229
' WM_MDIICONARRANGE = &H228
' WM_MDIMAXIMIZE = &H225
' WM_MDINEXT = &H224
' WM_MDIREFRESHMENU = &H234
' WM_MDIRESTORE = &H223
' WM_MDISETMENU = &H230
' WM_MDITILE = &H226
' WM_MEASUREITEM = &H2C
' WM_MENUCHAR = &H120
' WM_MENUSELECT = &H11F
' WM_MENURBUTTONUP = &H122
' WM_MENUDRAG = &H123
' WM_MENUGETOBJECT = &H124
' WM_MENUCOMMAND = &H126
' WM_MOUSEACTIVATE = &H21
' WM_MOUSEHOVER = &H2A1
' WM_MOUSELEAVE = &H2A3
' WM_MOUSEMOVE = &H200
' WM_MOUSEWHEEL = &H20A
' WM_MOVE = &H3
' WM_MOVING = &H216
' WM_NCACTIVATE = &H86
' WM_NCCALCSIZE = &H83
' WM_NCCREATE = &H81
' WM_NCDESTROY = &H82
' WM_NCHITTEST = &H84
' WM_NCLBUTTONDBLCLK = &HA3
' WM_NCLBUTTONDOWN = &HA1
' WM_NCLBUTTONUP = &HA2
' WM_NCMBUTTONDBLCLK = &HA9
' WM_NCMBUTTONDOWN = &HA7
' WM_NCMBUTTONUP = &HA8
' WM_NCMOUSEMOVE = &HA0
' WM_NCPAINT = &H85
' WM_NCRBUTTONDBLCLK = &HA6
' WM_NCRBUTTONDOWN = &HA4
' WM_NCRBUTTONUP = &HA5
' WM_NEXTDLGCTL = &H28
' WM_NEXTMENU = &H213
' WM_NULL = &H0
' WM_PAINT = &HF
' WM_PAINTCLIPBOARD = &H309
' WM_PAINTICON = &H26
' WM_PALETTECHANGED = &H311
' WM_PALETTEISCHANGING = &H310
' WM_PARENTNOTIFY = &H210
' WM_PASTE = &H302
' WM_PENWINFIRST = &H380
' WM_PENWINLAST = &H38F
' WM_POWER = &H48
' WM_POWERBROADCAST = &H218
' WM_PRINT = &H317
' WM_PRINTCLIENT = &H318
' WM_PSD_ENVSTAMPRECT = (&H400 + 5)
' WM_PSD_FULLPAGERECT = (&H400 + 1)
' WM_PSD_GREEKTEXTRECT = (&H400 + 4)
' WM_PSD_MARGINRECT = (&H400 + 3)
' WM_PSD_MINMARGINRECT = (&H400 + 2)
' WM_PSD_PAGESETUPDLG = (&H400)
' WM_PSD_YAFULLPAGERECT = (&H400 + 6)
' WM_QUERYDRAGICON = &H37
' WM_QUERYENDSESSION = &H11
' WM_QUERYNEWPALETTE = &H30F
' WM_QUERYOPEN = &H13
' WM_QUEUESYNC = &H23
' WM_QUIT = &H12
' WM_RBUTTONDBLCLK = &H206
' WM_RBUTTONDOWN = &H204
' WM_RBUTTONUP = &H205
' WM_RENDERALLFORMATS = &H306
' WM_RENDERFORMAT = &H305
' WM_SETCURSOR = &H20
' WM_SETFOCUS = &H7
' WM_SETFONT = &H30
' WM_SETHOTKEY = &H32
' WM_SETREDRAW = &HB
' WM_SETTEXT = &HC
' WM_SETTINGCHANGE = &H1A
' WM_SHOWWINDOW = &H18
' WM_SIZE = &H5
' WM_SIZING = &H214
' WM_SIZECLIPBOARD = &H30B
' WM_SPOOLERSTATUS = &H2A
' WM_SYSCHAR = &H106
' WM_SYSCOLORCHANGE = &H15
' WM_SYSCOMMAND = &H112
' WM_SYSDEADCHAR = &H107
' WM_SYSKEYDOWN = &H104
' WM_SYSKEYUP = &H105
' WM_TIMECHANGE = &H1E
' WM_TIMER = &H113
' WM_UNDO = &H304
' WM_USER = &H400
' WM_VKEYTOITEM = &H2E
' WM_VSCROLL = &H115
' WM_VSCROLLCLIPBOARD = &H30A
' WM_WINDOWPOSCHANGED = &H47
' WM_WINDOWPOSCHANGING = &H46
' WM_WININICHANGE = &H1A
'End Enum
Public Function StartHook() As Boolean
hHook = SetWindowsHookEx(WH_CALLWN
If hHook <> 0 Then
StartHook = True
End If
End Function
Public Sub StopHook()
UnhookWindowsHookEx hHook
hHook = 0
End Sub
Public Function AppHook(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim CWP As CWPSTRUCT
CopyMemory CWP, ByVal lParam, Len(CWP)
Select Case CWP.message
Case WM_QUERYENDSESSION
wParam = True
AppHook = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
Exit Function
Case WM_ENDSESSION
If IsNull(lParam) Then
'pc shutting down
ElseIf lParam = ENDSESSION_LOGOFF Then
'user is logging off
ElseIf lParam = 0 And IsWin2KorXP
Then
'PC is closing for 2k/xp
End If
End Select
AppHook = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
End Function
' Centrdlg sample from BlackBeltVB.com
' http://blackbeltvb.com
Credit goes to: ' Written by Matt Hart
' Copyright 1999 by Matt Hart
Please Note: This is a modified version. Matt asked that references to this code be directed to:
http://blackbeltvb.com/centrdlg.htm
However, the link does not exist at this time so I will post my modified version of it.
There is one dependancy for this module. (IsWin2korXP) you can create your own function to do this if you need to.
' Centrdlg sample from BlackBeltVB.com
' http://blackbeltvb.com
'
' Written by Matt Hart
' Copyright 1999 by Matt Hart
'
' This software is FREEWARE. You may use it as you see fit for
' your own projects but you may not re-sell the original or the
' source code. Do not copy this sample to a collection, such as
' a CD-ROM archive. You may link directly to the original sample
' using "http://blackbeltvb.com/centrdlg.htm"
'
' No warranty express or implied, is given as to the use of this
' program. Use at your own risk.
Option Explicit
Type CWPSTRUCT
lParam As Long
wParam As Long
message As Long
hwnd As Long
End Type
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Const WH_CALLWNDPROC = 4
Public Const GWL_WNDPROC = (-4)
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOACTIVATE = &H10
Private Const WM_QUERYENDSESSION = &H11
Private Const WM_ENDSESSION = &H16
Private Const ENDSESSION_LOGOFF = &H80000000
Public lWndProc As Long
Public hHook As Long, lHookWndProc As Long
'Private Enum WindowMessages
' WM_ACTIVATE = &H6
' WM_ACTIVATEAPP = &H1C
' WM_ASKCBFORMATNAME = &H30C
' WM_CANCELJOURNAL = &H4B
' WM_CANCELMODE = &H1F
' WM_CAPTURECHANGED = &H1F
' WM_CAPTURECHANGED_R = &H215
' WM_CHANGECBCHAIN = &H30D
' WM_CHAR = &H102
' WM_CHARTOITEM = &H2F
' WM_CHILDACTIVATE = &H22
' WM_CHOOSEFONT_GETLOGFONT = &H401
' WM_CHOOSEFONT_SETFLAGS = (&H400 + 102)
' WM_CHOOSEFONT_SETLOGFONT = (&H400 + 101)
' WM_CLEAR = &H303
' WM_CLOSE = &H10
' WM_COMMAND = &H111
' WM_COMPACTING = &H41
' WM_COMPAREITEM = &H39
' WM_CONTEXTMENU = &H7B
' WM_CONVERTREQUESTEX = &H108
' WM_COPY = &H301
' WM_COPYDATA = &H4A
' WM_CREATE = &H1
' WM_CTLCOLORBTN = &H135
' WM_CTLCOLORDLG = &H136
' WM_CTLCOLOREDIT = &H133
' WM_CTLCOLORLISTBOX = &H134
' WM_CTLCOLORMSGBOX = &H132
' WM_CTLCOLORSCROLLBAR = &H137
' WM_CTLCOLORSTATIC = &H138
' WM_CUT = &H300
' WM_DDE_ACK = (&H3E0 + 4)
' WM_DDE_ADVISE = (&H3E0 + 2)
' WM_DDE_DATA = (&H3E0 + 5)
' WM_DDE_EXECUTE = (&H3E0 + 8)
' WM_DDE_FIRST = &H3E0
' WM_DDE_INITIATE = &H3E0
' WM_DDE_LAST = (&H3E0 + 8)
' WM_DDE_POKE = (&H3E0 + 7)
' WM_DDE_REQUEST = (&H3E0 + 6)
' WM_DDE_TERMINATE = (&H3E0 + 1)
' WM_DDE_UNADVISE = (&H3E0 + 3)
' WM_DEADCHAR = &H103
' WM_DELETEITEM = &H2D
' WM_DESTROY = &H2
' WM_DESTROYCLIPBOARD = &H307
' WM_DEVICECHANGE = &H219
' WM_DEVMODECHANGE = &H1B
' WM_DRAWCLIPBOARD = &H308
' WM_DRAWITEM = &H2B
' WM_DROPFILES = &H233
' WM_ENABLE = &HA
' WM_ENDSESSION = &H16
' WM_ENTERIDLE = &H121
' WM_ENTERSIZEMOVE = &H231
' WM_ENTERMENULOOP = &H211
' WM_ERASEBKGND = &H14
' WM_EXITMENULOOP = &H212
' WM_EXITSIZEMOVE = &H232
' WM_FONTCHANGE = &H1D
' WM_GETDLGCODE = &H87
' WM_GETFONT = &H31
' WM_GETHOTKEY = &H33
' WM_GETMINMAXINFO = &H24
' WM_GETTEXT = &HD
' WM_GETTEXTLENGTH = &HE
' WM_HOTKEY = &H312
' WM_HSCROLL = &H114
' WM_HSCROLLCLIPBOARD = &H30E
' WM_ICONERASEBKGND = &H27
' WM_IME_CHAR = &H286
' WM_IME_COMPOSITION = &H10F
' WM_IME_COMPOSITIONFULL = &H284
' WM_IME_CONTROL = &H283
' WM_IME_ENDCOMPOSITION = &H10E
' WM_IME_KEYDOWN = &H290
' WM_IME_KEYLAST = &H10F
' WM_IME_KEYUP = &H291
' WM_IME_NOTIFY = &H282
' WM_IME_SELECT = &H285
' WM_IME_SETCONTEXT = &H281
' WM_IME_STARTCOMPOSITION = &H10D
' WM_INITDIALOG = &H110
' WM_INITMENU = &H116
' WM_INITMENUPOPUP = &H117
' WM_INPUTLANGCHANGEREQUEST = &H50
' WM_INPUTLANGCHANGE = &H51
' WM_KEYDOWN = &H100
' WM_KEYUP = &H101
' WM_KILLFOCUS = &H8
' WM_LBUTTONDBLCLK = &H203
' WM_LBUTTONDOWN = &H201
' WM_LBUTTONUP = &H202
' WM_MBUTTONDBLCLK = &H209
' WM_MBUTTONDOWN = &H207
' WM_MBUTTONUP = &H208
' WM_MDIACTIVATE = &H222
' WM_MDICASCADE = &H227
' WM_MDICREATE = &H220
' WM_MDIDESTROY = &H221
' WM_MDIGETACTIVE = &H229
' WM_MDIICONARRANGE = &H228
' WM_MDIMAXIMIZE = &H225
' WM_MDINEXT = &H224
' WM_MDIREFRESHMENU = &H234
' WM_MDIRESTORE = &H223
' WM_MDISETMENU = &H230
' WM_MDITILE = &H226
' WM_MEASUREITEM = &H2C
' WM_MENUCHAR = &H120
' WM_MENUSELECT = &H11F
' WM_MENURBUTTONUP = &H122
' WM_MENUDRAG = &H123
' WM_MENUGETOBJECT = &H124
' WM_MENUCOMMAND = &H126
' WM_MOUSEACTIVATE = &H21
' WM_MOUSEHOVER = &H2A1
' WM_MOUSELEAVE = &H2A3
' WM_MOUSEMOVE = &H200
' WM_MOUSEWHEEL = &H20A
' WM_MOVE = &H3
' WM_MOVING = &H216
' WM_NCACTIVATE = &H86
' WM_NCCALCSIZE = &H83
' WM_NCCREATE = &H81
' WM_NCDESTROY = &H82
' WM_NCHITTEST = &H84
' WM_NCLBUTTONDBLCLK = &HA3
' WM_NCLBUTTONDOWN = &HA1
' WM_NCLBUTTONUP = &HA2
' WM_NCMBUTTONDBLCLK = &HA9
' WM_NCMBUTTONDOWN = &HA7
' WM_NCMBUTTONUP = &HA8
' WM_NCMOUSEMOVE = &HA0
' WM_NCPAINT = &H85
' WM_NCRBUTTONDBLCLK = &HA6
' WM_NCRBUTTONDOWN = &HA4
' WM_NCRBUTTONUP = &HA5
' WM_NEXTDLGCTL = &H28
' WM_NEXTMENU = &H213
' WM_NULL = &H0
' WM_PAINT = &HF
' WM_PAINTCLIPBOARD = &H309
' WM_PAINTICON = &H26
' WM_PALETTECHANGED = &H311
' WM_PALETTEISCHANGING = &H310
' WM_PARENTNOTIFY = &H210
' WM_PASTE = &H302
' WM_PENWINFIRST = &H380
' WM_PENWINLAST = &H38F
' WM_POWER = &H48
' WM_POWERBROADCAST = &H218
' WM_PRINT = &H317
' WM_PRINTCLIENT = &H318
' WM_PSD_ENVSTAMPRECT = (&H400 + 5)
' WM_PSD_FULLPAGERECT = (&H400 + 1)
' WM_PSD_GREEKTEXTRECT = (&H400 + 4)
' WM_PSD_MARGINRECT = (&H400 + 3)
' WM_PSD_MINMARGINRECT = (&H400 + 2)
' WM_PSD_PAGESETUPDLG = (&H400)
' WM_PSD_YAFULLPAGERECT = (&H400 + 6)
' WM_QUERYDRAGICON = &H37
' WM_QUERYENDSESSION = &H11
' WM_QUERYNEWPALETTE = &H30F
' WM_QUERYOPEN = &H13
' WM_QUEUESYNC = &H23
' WM_QUIT = &H12
' WM_RBUTTONDBLCLK = &H206
' WM_RBUTTONDOWN = &H204
' WM_RBUTTONUP = &H205
' WM_RENDERALLFORMATS = &H306
' WM_RENDERFORMAT = &H305
' WM_SETCURSOR = &H20
' WM_SETFOCUS = &H7
' WM_SETFONT = &H30
' WM_SETHOTKEY = &H32
' WM_SETREDRAW = &HB
' WM_SETTEXT = &HC
' WM_SETTINGCHANGE = &H1A
' WM_SHOWWINDOW = &H18
' WM_SIZE = &H5
' WM_SIZING = &H214
' WM_SIZECLIPBOARD = &H30B
' WM_SPOOLERSTATUS = &H2A
' WM_SYSCHAR = &H106
' WM_SYSCOLORCHANGE = &H15
' WM_SYSCOMMAND = &H112
' WM_SYSDEADCHAR = &H107
' WM_SYSKEYDOWN = &H104
' WM_SYSKEYUP = &H105
' WM_TIMECHANGE = &H1E
' WM_TIMER = &H113
' WM_UNDO = &H304
' WM_USER = &H400
' WM_VKEYTOITEM = &H2E
' WM_VSCROLL = &H115
' WM_VSCROLLCLIPBOARD = &H30A
' WM_WINDOWPOSCHANGED = &H47
' WM_WINDOWPOSCHANGING = &H46
' WM_WININICHANGE = &H1A
'End Enum
Public Function StartHook() As Boolean
hHook = SetWindowsHookEx(WH_CALLWN
If hHook <> 0 Then
StartHook = True
End If
End Function
Public Sub StopHook()
UnhookWindowsHookEx hHook
hHook = 0
End Sub
Public Function AppHook(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim CWP As CWPSTRUCT
CopyMemory CWP, ByVal lParam, Len(CWP)
Select Case CWP.message
Case WM_QUERYENDSESSION
wParam = True
AppHook = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
Exit Function
Case WM_ENDSESSION
If IsNull(lParam) Then
'pc shutting down
ElseIf lParam = ENDSESSION_LOGOFF Then
'user is logging off
ElseIf lParam = 0 And IsWin2KorXP
Then
'PC is closing for 2k/xp
End If
End Select
AppHook = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
End Function
To capture close event you could unselect the WM_CLOSE constant and add it to the case statement in the AppHook function. I don't think it will help you however.
ASKER
Thanks for the code TimW1
i did this in the last part:
Case WM_CLOSE
MsgBox "warning, some process is trying to kill me off. But this program is indestructable."
and then i tried to run another program in visual basic that terminates the said program, but frankly, Case WM_CLOSE was not called in the program because no message box appeared saying the above message.
By the way, do you have to call the function AppHook in the main form? ...because i didn't. thanks
i did this in the last part:
Case WM_CLOSE
MsgBox "warning, some process is trying to kill me off. But this program is indestructable."
and then i tried to run another program in visual basic that terminates the said program, but frankly, Case WM_CLOSE was not called in the program because no message box appeared saying the above message.
By the way, do you have to call the function AppHook in the main form? ...because i didn't. thanks
renz2003:
This old question needs to be finalized -- accept an answer, split points, or get a refund. For information on your options, please click here-> http:/help/closing.jsp#1
Experts: Post your closing recommendations! Who deserves points here?
This old question needs to be finalized -- accept an answer, split points, or get a refund. For information on your options, please click here-> http:/help/closing.jsp#1
Experts: Post your closing recommendations! Who deserves points here?
Moderator, my recommended disposition is:
Accept TimW1's comment(s) as an answer.
DanRollins -- EE database cleanup volunteer
Accept TimW1's comment(s) as an answer.
DanRollins -- EE database cleanup volunteer
This wont allow the form to be terminated (unless extreme force is used)