Mrrrr
AdMiN
 Inregistrat: acum 17 ani
Postari: 2186
|
|
In order to prevent Windows from going to Lock Screen every 5 minutes, you must either move the cursor every now and then, or do something else. But if you go away from it for, maybe, 10 minutes, a few times a day, you would have to enter your password every time again and again and again.
If you're at work, it might have a purpose and you'd better leave it at that and just enter your password. Or not! :rolleyes:
If you use a computer in the same room with others, and you are not the admin so you can't change some power configuration settings to prevent Windows from going to Lock Screen so often, then the following code should help.
The code below will open a popup box every 4 minutes and 30 seconds, and will close it shortly after, therefore something is done on Windows to prevent it from locking the screen.
This is by far not the best code and it can be improved for sure, but it's what I came up with fast, and it works.
Option Explicit
Dim count, mins, msg, strMessage
Dim Excel, GetMessagePos, x, x1, y, y1, Position
Set Excel = WScript.CreateObject("Excel.Application")
GetMessagePos = Excel.ExecuteExcel4Macro("CALL(""user32"",""GetMessagePos"",""J"")")
x = CLng("&H" & Right(Hex(GetMessagePos), 4))
y = CLng("&H" & Left(Hex(GetMessagePos), (Len(Hex(GetMessagePos)) - 4)))
WScript.Sleep (5000)
GetMessagePos = Excel.ExecuteExcel4Macro("CALL(""user32"",""GetMessagePos"",""J"")")
x1 = CLng("&H" & Right(Hex(GetMessagePos), 4))
y1 = CLng("&H" & Left(Hex(GetMessagePos), (Len(Hex(GetMessagePos)) - 4)))
If x = x1 And y = y1 Then
DoTheLoop
Else
msg = MsgBox("Quit script?", vbYesNo)
If msg = vbYes Then
MsgBox "Script cancelled, you are back at the computer"
Set Excel = Nothing
WScript.Quit
End If
End If
' Sub to loop check cursor position
Sub DoTheLoop()
count = 0
mins = 5
Do While count < 13 ' < 2 = 10 minutes < 13 = 60 minutes
WScript.Sleep (290000) ' 5 min = 5 * 60 * 1000 = 300000
' didn't set to 5 minutes sharp, because then it goes to lock screen
' checks if mouse was moved while waiting those almost 5 minutes
GetMessagePos = Excel.ExecuteExcel4Macro("CALL(""user32"",""GetMessagePos"",""J"")")
x1 = CLng("&H" & Right(Hex(GetMessagePos), 4))
y1 = CLng("&H" & Left(Hex(GetMessagePos), (Len(Hex(GetMessagePos)) - 4)))
If x <> x1 Or y <> y1 Then
Exit Do
End If
' if it hasn't moved, it will display a popul message for 2 seconds, then close it
With CreateObject("WScript.Shell")
.Popup mins & " minutes have passed", 2
End With
mins = mins + 5
count = count + 1
' checks again so it doesn't wait another 5 minutes and instead quits WScript
GetMessagePos = Excel.ExecuteExcel4Macro("CALL(""user32"",""GetMessagePos"",""J"")")
x1 = CLng("&H" & Right(Hex(GetMessagePos), 4))
y1 = CLng("&H" & Left(Hex(GetMessagePos), (Len(Hex(GetMessagePos)) - 4)))
If x <> x1 Or y <> y1 Then
Exit Do
End If
Loop
WScript.Quit
End Sub |
Source for the GetMessagePos part:
_______________________________________
|
|
