Forcing a Game program to terminate

[vikoy]

Hi to all,

I'm looking for a source code on how to force a game program like DOOM or COUNTER STRIKE which run in a full dos mode (without a window caption) unlike some dos program which has,
the reason i'm doing this is because i've wanted to limit the time spent by my child in playing those games. (a program runs in the background that monitors these games) .

Please help ASAP.

[macky]

I also have this problem and still working on it. Temporarily, I use the ExitWindowsEX API and use uFlags = 0 to logoff the user because this API will close all programs running so there's not much use of your VB code after calling this API.

[Nucleus]

Do you have the handle of the window?

[macky]

yes, the game handle can be retrieved!!

[vikoy]

How do u do it?

[macky]

From the processID of the shell, get the desktop handle and trace the child that matches the processID you got from the shell therefore, the handle of that child is the handle of your game or application for that matter.

[Nucleus]

Option Explicit
 
Private Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" (ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal fuFlags As Long, ByVal uTimeout As Long, lpdwResult As Long) As Long
Private Const SC_CLOSE = &HF060&
Private Const WM_SYSCOMMAND = &H112
 
 
Private Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Const PROCESS_ALL_ACCESS = &H1F0FFF
 
Private Declare Function TerminateProcess& Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long)
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
 
 
Sub CloseApp(ByVal hwnd&)
    Dim lPid                    As Long
    Dim lHp                     As Long
 
    SendMessageTimeout hwnd, WM_SYSCOMMAND, SC_CLOSE, 0, 0, 500, 0
    '
    ' If the window doesn't like gentle persuasion, bring out the nipple clamps to force it to close
    '
    If IsWindow(hwnd) Then
        Call GetWindowThreadProcessId(hwnd, lPid)
        lHp = OpenProcess(PROCESS_ALL_ACCESS, 0&, lPid)
        TerminateProcess lHp&, 0&
        CloseHandle lHp
    End If
 
 
End Sub

[macky]

Will try it out, I've been trying the CloseHandle for 3 days already, and the game is just too stubborn not to quit. May I try out your code? Thanks in advance for the help and will let you know in awhile!

[macky]

The game kept on running. I tried also ExitProcess and my VB application ended instead. What am I doing wrong?

[Nucleus]

I don't have any games on this pc, but I started the dos emulator and was able to close the window with the following code. Are you sure you have the correct hwnd?

Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Sub Command1_Click()
Dim lhwnd&
 
lhwnd = FindWindow(vbNullString, "Command Prompt")
CloseApp (lhwnd)
End Sub

[macky]

I used the following code that I got from vbnet to get the handle:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2001 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' You are free to use this code within your own applications,
' but you are expressly forbidden from selling or otherwise
' distributing this source code without prior written consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Const GW_HWNDFIRST = 0
Public Const GW_HWNDNEXT = 2
Public Const GW_CHILD = 5

Public Declare Function GetWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal wCmd As Long) As Long

Public Declare Function GetDesktopWindow Lib "user32" () As Long

Public Declare Function GetWindowThreadProcessId Lib "user32" _
(ByVal hwnd As Long, _
lpdwProcessId As Long) As Long

Public Declare Function BringWindowToTop Lib "user32" _
(ByVal hwnd As Long) As Long

Public Declare Function SetWindowText Lib "user32" _
Alias "SetWindowTextA" _
(ByVal hwnd As Long, ByVal _
lpString As String) As Long

Public Declare Function GetClassName Lib "user32" _
Alias "GetClassNameA" _
(ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long

Public Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long

Public Const WM_SETTEXT = &HC
'--end block--'

Option Explicit

Private Sub Command1_Click()

Dim hWndApp As Long

'call the wrapper function to start shell,
'and return the handle to the shelled app.
hWndApp = StartShell("notepad.exe")

'if found, prove it!
If hWndApp Then

'change its caption
Call SetWindowText(hWndApp, "The handle to Notepad is " & CStr(hWndApp))

'bring it to the top
Call BringWindowToTop(hWndApp)

'and add some text to its edit window
Call PutTextIntoNotepad(hWndApp)

End If

End Sub


Public Function GethWndFromProcessID(hProcessIDToFind As Long) As Long

Dim hWndDesktop As Long
Dim hWndChild As Long
Dim hWndChildProcessID As Long

On Local Error GoTo GethWndFromProcessID_Error

'get the handle to the desktop
hWndDesktop = GetDesktopWindow()

'get the first child under the desktop
hWndChild = GetWindow(hWndDesktop, GW_CHILD)

'hwndchild will = 0 when no more child windows are found
Do While hWndChild <> 0

'get the ThreadProcessID of the window
Call GetWindowThreadProcessId(hWndChild, hWndChildProcessID)

'if it matches the target, exit returning that value
If hWndChildProcessID = hProcessIDToFind Then
GethWndFromProcessID = hWndChild
Exit Do
End If

'not found, so get the next hwnd
hWndChild = GetWindow(hWndChild, GW_HWNDNEXT)

Loop

Exit Function

GethWndFromProcessID_Error:
GethWndFromProcessID = 0
Exit Function

End Function


Private Function StartShell(sApplication As String) As Long

Dim hProcessID As Long

'start using shell, and get the process ID
hProcessID = Shell(sApplication, vbNormalFocus)

'return the hwnd to the shelled process
StartShell = GethWndFromProcessID(hProcessID)

End Function


Private Sub PutTextIntoNotepad(hWndApp As Long)

'This adds text to notepad, by locating its
''Edit' class window. This is similar to the
'method used to locate the hwnd itself, but
'here we know the parent (hWndApp) so only
'have to search its child windows.

Dim hWndChild As Long
Dim sMsg As String
Dim sBuffer As String * 32
Dim nSize As Long

'this string is split only to fit the browser window
sMsg = "This method demonstrates using Shell() "
sMsg = sMsg & "to launch notepad, obtain its hwnd using "
sMsg = sMsg & "GetWindowThreadProcessId, and then use that"
sMsg = sMsg & "hwnd to change its caption and place text into "
sMsg = sMsg & "its Edit window using SetWindowText and SendMessage."

'get the first child window in Notepad
hWndChild = GetWindow(hWndApp, GW_CHILD)

'hwndchild will = 0 when no more child windows are found
Do While hWndChild <> 0

'get the Class Name of the window
nSize = GetClassName(hWndChild, sBuffer, 32)

'if nSize > 0, it contains the length
'of the class name retrieved
If nSize Then

'if the class name is "Edit",
'set some text and exit
If Left$(sBuffer, nSize) = "Edit" Then

Call SendMessage(hWndChild, WM_SETTEXT, 0&, ByVal sMsg)
Exit Sub

End If

End If

'not found, so get the next hwnd
hWndChild = GetWindow(hWndChild, GW_HWNDNEXT)

Loop

End Sub
'--end block--'

[macky]

I tried Gates' code on a game and it works. You can see his code on page 4 of this forum under the subject "shutting down an exe application", but it doesn't work on an NT or 2K.