When the user changes windows

When the user changes windows

This example demonstrates two methods of preventing users from playing Solitaire. An alternative method would be to remove Solitaire.exe from the hard drive, but the methods presented here will work even if the user attempts to run Solitaire from a copy stored on a floppy disk.

To create this example from scratch, create a standard exe project with one form. Open zip file

The form has the following controls (not including the various labels):

txtmLog	TextBox. Used to display a log of CBT events as they are trapped. Newest events are shown at the top.
chkmDisableSolitaire1	CheckBox. Disables Solitaire using method 1, which is to prevent creation of the Solitaire window.
chkmDisableSolitaire2	CheckBox. Disable Solitaire using method 2, which is to prevent activation of the Solitaire window after it has been created.
btnmClose	CommandButton. Closes the dialog.

The code for this form is below:

Option Explicit

'SendMessage API is used to disable Solitaire (method 2).
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_CLOSE = &H10

'Object to receive CBT events must be declared at
'class or form level.
Private WithEvents objmCbtEvents As CbtEvents

Private Sub btnmClose_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    'Start monitoring the system for CBT Events.
    Set objmCbtEvents = GetAllThreads.CbtEvents
End Sub

Private Sub LogAction(ByVal sAction As String)
    'Append the latest action to the first line of the TextBox,
    'so that newest actions appear first, oldest last.
    txtmLog.Text = sAction & vbCrLf & txtmLog.Text
End Sub

Private Sub Form_Unload(Cancel As Integer)
    'Need to set our object for receiving CBT events to Nothing
    'otherwise it will receive a DestroyWindow event for this
    'dialog - after it has been unloaded (which will result in an
    'error when the handler for the DestroyWindow event tries
    'to update a TextBox on the form).
    Set objmCbtEvents = Nothing
End Sub

Private Sub objmCbtEvents_DestroyWindow(Window As AkemiSpyLibrary.Window, Cancel As Boolean)
    LogAction "DestroyWindow" & Window.Caption
End Sub

Private Sub objmCbtEvents_MinMaxWindow(Window As AkemiSpyLibrary.Window, ByVal State As AkemiSpyLibrary.WindowStateConstants, Cancel As Boolean)
    Select Case State
        Case SW_MAXIMIZE
            LogAction "Maximize " & Window.Caption
        Case SW_MINIMIZE
            LogAction "Minimize " & Window.Caption
        Case SW_RESTORE
            LogAction "Restore " & Window.Caption
    End Select
End Sub

Private Sub objmCbtEvents_MoveSizeWindow(ByVal Window As AkemiSpyLibrary.Window, ByVal Left As Long, ByVal Top As Long, ByVal Width As Long, ByVal Height As Long)
    LogAction "Move/Size " & Window.Caption
End Sub

Private Sub objmCbtEvents_SetFocus(Window As AkemiSpyLibrary.Window, PreviousWindow As AkemiSpyLibrary.Window, Cancel As Boolean)
    LogAction "SetFocus " & Window.Caption
End Sub

Private Sub objmCbtEvents_CreateWindow(Window As AkemiSpyLibrary.Window, Style As Long, ExStyle As Long, Cancel As Boolean)
    LogAction "CreateWindow (Class=" & Window.ClassName & ")"
    If chkmDisableSolitaire1.Value And Window.ClassName = "Solitaire" Then
        'Cancel the creation of the Solitaire window.
        'I know that the ClassName of the Solitaire Window is "Solitaire",
        'from running the ListOfOpenWindows example whilst an instance
        'of Solitaire is open. The caption of the window cannot be checked
        'at this stage because the Window has not been created yet.

        'The solitaire application will interpret the failure to create a
        'window, as an "Out of Memory" error.
        Cancel = True
        LogAction "Solitaire Disabled"
        MsgBox "Sorry, you are not allowed to play Solitaire. (1)"
    End If
End Sub

Private Sub objmCbtEvents_ActivateWindow(Window As AkemiSpyLibrary.Window, Cancel As Boolean)
    LogAction "ActivateWindow " & Window.Caption
    If chkmDisableSolitaire2.Value And Window.Caption = "Solitaire" Then
        'This method of disabling Solitaire is better, because
        'it waits until Solitaire has successfully created its window,
        'so the Solitaire application will not be confused.
        'Also, by the time a window is about to be activated, its
        'caption has been set, so it is possible to block a window
        'based on either ClassName or Caption.
        Cancel = True
        SendMessage Window, WM_CLOSE, 0, 0
        MsgBox "Sorry, you are not allowed to play Solitaire (2)"
    End If
End Sub

Home	Copyright and Disclaimer