Block the Screen

[eimroda]

I have a business where I lend computers to customers for a certain amount for a specified number of hours. Mostly, customers rented my computers for gaming (Counter Strike, Quake 3....). I am maintaining 15 computers manually and I found it hard to keep track on the usage of the computers. What I want is that I'll make a program that is going to block the screen after the specified time (No. of minutes/hours) automatically, thus preventing the user to continue using the computer if his time is up. I created a program with such purpose by using the SetWindowPos API. I was successful when the user is only using windows apps. such as MS Office or the internet. But in terms of games, when it attempted to block the screen, all I get is a blinking screen and the game application prevailed. Is there any other API to use to solve this problem or is there any free program with such purpose whcih I can download?

[Matthew Gates]

An idea would be to add your program to startup (maybe have a password that needs to be entered in order to remove the screen) and then force windows to shut down.

To shutdown windows, you can use the ExitWindowsEx API function.

Private Declare Function ExitWindowsEx Lib "user32" _
(ByVal uFlags As Long, ByVal dwReserved As Long) As Long
 
Const EWX_LOGOFF = 0
Const EWX_SHUTDOWN = 1
Const EWX_REBOOT = 2
Const EWX_FORCE = 4
 
Private Sub Form_Load()
    Msgbox "Your time usage is up, please return this computer to it's owner.", 16
    ExitWindowsEx EWX_FORCE Or EWX_SHUTDOWN, 0
End Sub

Than when the computer starts back up, if the person turns it back on, since the program runs at startup (use the Registry), it will block the screen and that's it. Perhaps a label saying that, "Your usage is up, please return this computer to the owner" and having a button to shutdown again or something. And than you can have a shortcut key so that you can enter in a password and remove all the settings for startup, etc.

Just a suggestion: maybe it will work .

[plenderj]

Another approach, though I dont know if it would work or not, would be to have an application that, once the time has elapsed, uses the AlwaysOnTop code to always stay on top of other programs.

So that should take care of things in windows.
Then to make sure that its visible instead of other games, you could maybe make the system do the equivalent of Alt-Tab and make that app active.

Though I cant really see 3D games being too happy with that.

Surely it would be better if there was an app running that just emailed you or something when their time is up. Then you, or another member of staff can ask them to wrap up...

[eimroda]

For Matthew:

But the user have the option to resume and logging him off will also disconnect him from the current game server. When the program blocks the screen, the workstation should not be disconnected from the game server. any ideas please?

For Plenderj:
I have already used

SetWindowPos hwnd, HWND_TOPMOST, 0, 0, wid, hgt, 0

to make the program on top of other apps., but I still try to use the ctrl tab.... I know there's a solution for this since I saw some internet cafe's using a software like it, and i want to customize it to meet my needs..please help!!!!!!

[plenderj]

How about this :

AppActivate Me.Caption

with a dash of GetTickCount, a hint of DoEvents, and a smidgen of a Do Loop.

[eimroda]

Im not familiar with GetTickCount, please show me your code, if you wont mind...please?????

[plenderj]

Okay well you could use a timer to call this, but I personally would use GetTickCount().

Option Explicit
 
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private 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
 
Private Const SWP_NOMOVE = 2
Private Const SWP_NOSIZE = 1
Private Const SWP_WNDFLAGS = SWP_NOMOVE Or SWP_NOSIZE
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private lastTick As Long
Private meCaption As String
 
Private Sub takeControl()
    Me.Show
    meCaption = Me.Caption
    SetTopmost Me, True
    Do
        DoEvents
        If ((GetTickCount() - lastTick) >= 100) Then
            lastTick = GetTickCount()
            AppActivate meCaption
        End If
    Loop
End Sub
 
Private Sub SetTopmost(frm As Form, bTopmost As Boolean)
     If bTopmost = True Then
          SetWindowPos frm.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_WNDFLAGS
     Else
          SetWindowPos frm.hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_WNDFLAGS
     End If
End Sub

You can change the 100 there to make different delays.

[eimroda]

thank you very much...Ill try this as I get home....

[plenderj]

I just made a modification that you might not have seen yet.

[eimroda]

By the way, my program got no caption...

[eimroda]

Sorry but I am going home now...if you wont mind (again) could you please email me if you got it perfect? Here's my email add: [email protected] please.... I need this...

[plenderj]

Well give it a bloody caption

[Dimension]

me.caption = "bloddy caption"

[plenderj]

Originally posted by Dimension
me.caption = "bloddy caption"

With Me
    .Caption = "Blah !"
    .Caption.Bloody = True
End With

[amitabh]

Also, make your app appear as screensaver using SystemParametersInfo api call, so that Alt-Tab, Window and other shortcut keys get disabled.

[nishantp]

Oh also...another way of doing that is once your program is on top for sure, you can disable Alt-Ctrl-Del and Alt-Tab...so the user is pretty much stuck inside your program. Set the BorderStyle to none (sorry, no caption... but maybe you can still assign something to the caption property) and use SetWindowsPos to make it sull screen. Heres a URL that demonstrates how to disable Alt-Ctrl-Del and alt-tab:

http://www.internettrash.com/users/fdb/68_TXT.htm

[plenderj]

Ah sure the Caption thing isnt all that important.
There's better ways of doing it, I was just giving him the quickest/easiest way of doing it.

[nishantp]

Originally posted by amitabh
Also, make your app appear as screensaver using SystemParametersInfo api call, so that Alt-Tab, Window and other shortcut keys get disabled.

Dough!! beat me to it...

[eimroda]

APIs I've used so far:

SystemParametersInfo, SetWindowPos but to no avail. The screen just keep on flashing as it tried to block the screen with a 3d game currently running. I have no problem with other applications (e.g. word, excel, ie etc...) because with my current program, it successfully blocked them. My problem is when the program deals with a 3d game, it cant totally block the screen and it just keep on flashing...

[Tygur]

Is there anything wrong with forcing a shutdown when the time runs out? That would probably be easier..

[Bloodeye]

I think Tygur's right about this one.
More than likely the 3d game is using the same API's
The only thing I would add is you will need to change the
password for login before you force the shutdown.

[amitabh]

Originally posted by eimroda
APIs I've used so far:

SystemParametersInfo, SetWindowPos but to no avail. The screen just keep on flashing as it tried to block the screen with a 3d game currently running. I have no problem with other applications (e.g. word, excel, ie etc...) because with my current program, it successfully blocked them. My problem is when the program deals with a 3d game, it cant totally block the screen and it just keep on flashing...

It might be that directx is being used which is stopping all other forms from being on Top. Try minimizing all windows present on desktop and then use your app to block the screen.

[Nucleus]

I just threw this together, maybe it will work.

After the time period runs out, just call this function from a timer. It will minimize all windows except your application.

Code in Module:

Option Explicit
 
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Const WS_MINIMIZEBOX = &H20000
Private Const GWL_STYLE = (-16)
Private Declare Function IsWindowVisible& Lib "user32" (ByVal hwnd As Long)
Private Declare Function ShowWindow& Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long)
Private Const SW_SHOWMINIMIZED = 2
Private Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
 
 
Dim m_lHwnd             As Long
 
Public Sub MinimizeExcept(ByVal sCaption As String)
 
m_lHwnd = FindWindowEx(0, 0, vbNullString, sCaption)
If m_lHwnd Then
    EnumWindows AddressOf EnumWindowsProc, 0&
End If
 
End Sub
 
 
Public Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Long
Dim lStyle              As Long
 
    If hwnd <> m_lHwnd Then
        lStyle = GetWindowLong(hwnd, GWL_STYLE)
        If (lStyle And WS_MINIMIZEBOX) = WS_MINIMIZEBOX And IsWindowVisible(hwnd) Then
            Call ShowWindow(hwnd, SW_SHOWMINIMIZED)
        End If
    End If
    
    EnumWindowsProc = 1
End Function

Example usage:

Call MinimizeExcept("Security App Caption Goes Here")

[eimroda]

Thank guys. But logging off/shutting down the computer is not applicable since the user has the tendency to resume, meaning he is going to pay/rent again for a specified period of time and he must continue playing where he stopped, so logging him off will disconnect him from the games server and he will connect again to the server.

To Nucleus, Ill try this one out. But my application has no caption...anyway Ill try it out...

[Tygur]

If you really don't want your form to have a caption, you can try this code. I took Nucleus's code and modified so it minimizes all windows that are not part of your app, instead of going by caption.

Option Explicit
 
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Const WS_MINIMIZEBOX = &H20000
Private Const GWL_STYLE = (-16)
Private Declare Function IsWindowVisible& Lib "user32" (ByVal hwnd As Long)
Private Declare Function ShowWindow& Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long)
Private Const SW_SHOWMINIMIZED = 2
Private Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
 
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
 
'This was originally made by Nucleus, then I (Tygur) modified it.
'the "Us" in the function name refers to all the forms in this app, instead of just one
Public Sub MinimizeExceptUs()
EnumWindows AddressOf EnumWindowsProc, 0&
End Sub
 
 
Public Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Long
Dim lStyle As Long
Dim lThreadID As Long
 
lThreadID = GetWindowThreadProcessId(hwnd, ByVal 0)
If lThreadID <> App.ThreadID Then
    lStyle = GetWindowLong(hwnd, GWL_STYLE)
    If (lStyle And WS_MINIMIZEBOX) = WS_MINIMIZEBOX And IsWindowVisible(hwnd) Then
        Call ShowWindow(hwnd, SW_SHOWMINIMIZED)
    End If
End If
 
EnumWindowsProc = 1
End Function

'Usage:
MinimizeExceptUs

[venom8]

to Tygur:

i try ur code, but i'm getting an error : "Invalid Use of AddressOf Operator" and it's pointing in

Public Sub MinimizeExceptUs()
EnumWindows AddressOf EnumWindowsProc, 0&
End Sub

i paste ur code in general declaration of Form1, then i set the caption property to " ", and i add a command button and put "MinimizeExceptUs".

[Tygur]

Paste all the the code into a module. Then you can call MinimizeExceptUs from anywhere. It doesn't matter what the caption of the form is set at. You can set it to anything you want or nothing at all.

[venom8]

Thank's Tygur, it works now.

But i just want to ask u, what can u say about my suggestion to kill the program first , knowing their path, before blocking the screen?

[Nucleus]

Tygur, nice amendment, and glad that my work on minimizing windows eventually lead to something useful.

[stever2003]

i have a program called SecureIt, this is probably the kind of thing that you want, except i dont know if you can implement this specific program in your situation. The program's website is http://go.to/quantrix. If they don't have the program or only have an evaluation, email me at [email protected] and I'll send it to you (or post it on the site so its available to everyone)

[eimroda]

I have already tried tygur's code but it produced the same result. It could not minimize the 3d game that's running, thus same with my program, it only caused the screen to flash as it tried to block the screen. Anyway it is successful when blocking windows based applications such as office, ie, etc..

By the way, forcibly logging off the user will cause him to be disconnected from the game's server, so when he logs on to windows, he must reconnect to the games server again and start all over again aside from the time consumed in logging in and reconnection.

[eimroda]

Any ideas please?? I need it very urgent..

[JamesM]

Does the game window have a minimize icon on it, like can you manually minimize the game by clicking on a button?

[eimroda]

No sir. The 3d game occupied the whole screen.

[Nucleus]

Ok well try this code then...

In Module:

Option Explicit
 
Private Declare Function IsWindowVisible& Lib "user32" (ByVal hwnd As Long)
Private Declare Function ShowWindow& Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long)
Const SW_HIDE = 0
Const SW_SHOW = 5
 
Private Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
 
Private m_hiddenHwnds()     As Long
Private m_hTaskBar          As Long
Private m_hDeskTopIcons     As Long
 
' Nucleus and Tygur
' the "Us" in the function name refers to all the forms in this app, instead of just one
Public Sub HideExceptUs()
    m_hDeskTopIcons = FindWindowEx(0&, 0&, "Progman", vbNullString)
    m_hTaskBar = FindWindowEx(0&, 0&, "Shell_TrayWnd", vbNullString)
    EnumWindows AddressOf EnumWindowsProc, 0&
End Sub
 
Public Sub Unhide()
On Error Resume Next
 
Dim i               As Long
 
For i = 0 To UBound(m_hiddenHwnds)
    ShowWindow m_hiddenHwnds(i), SW_SHOW
Next
 
Erase m_hiddenHwnds
End Sub
 
 
 
Public Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Long
Dim lThreadID       As Long
 
If hwnd <> m_hTaskBar And hwnd <> m_hDeskTopIcons Then
 
    lThreadID = GetWindowThreadProcessId(hwnd, ByVal 0)
    If lThreadID <> App.ThreadID Then
    
        If IsWindowVisible(hwnd) Then
            
            On Error Resume Next
            ReDim Preserve m_hiddenHwnds(UBound(m_hiddenHwnds) + 1)
            If Err Then ReDim m_hiddenHwnds(0)
            On Error GoTo 0
            m_hiddenHwnds(UBound(m_hiddenHwnds)) = hwnd
            ShowWindow hwnd, SW_HIDE
    
        End If
    End If
    
End If
 
EnumWindowsProc = 1
 
End Function

Example usage, create 2 command buttons then add this code:

Private Sub Command1_Click()
 
HideExceptUs
 
End Sub
 
Private Sub Command2_Click()
 
Unhide
 
End Sub

[nemaroller]

So, my question is, there are actually people out there who will RENT computers just to game? Interesting... if you don't mind indulging us.... how profitable is this side venture of yours?

[scostell]

I've never done what your trying to do, but I have played my share of games (like Quake and such) and I've had times where another program, say AIM would pop up a message from someone and it would automatically minimize my Game Screen. I'm not sure how or why, but it happens.

This probably won't be any help at all but maybe you can start up a game and find something that minimizes it. Also if I were to hit the 'Windows' key on my keyboard it would do the same thing. Not sure if this works in all games but it has worked in the ones i've played.

[Skitchen8]

um... alt+tab does that too

[scostell]

I thought alt tab would also, just wasn't sure. anyhow maybe he can have VB send those key strokes, Minimize the game, throw up the block Screen and then disable alt tab.