VBS logout script to repeatedly prompt the user to enter a password every 15 seconds - vbscript

I am currently working on a VBS script that prompts the user to enter a password every 60 seconds. The script is intended to log the user out if they enter the wrong password twice within a 60 second interval, or if there is no response.
However, I am having trouble figuring out how to detect if the inputbox has been inactive for more than 60 seconds. Can anyone please help me with this issue? I would greatly appreciate any suggestions or solutions.
Also, is there any way to fix bugs in the code that may cause the script to malfunction?
Dim Password, Input, count
Password = "qq"
count = 0
Do
Do
Input = InputBox("Please enter your password:", "Password Required", "")
If Input = Password Then
Exit Do
Else
count = count + 1
Input = InputBox("Please enter your password:", "Password Required", "")
If count = 2 Then
Set objShell = CreateObject("WScript.Shell")
objShell.Run "shutdown /l", 0, True
End If
End If
Loop
WScript.Sleep 60000
Loop

Typically, all you need to do to protect the computer when nodding off is to a) ensure your account has a password, and b) set the computer to automatically turn off the display after a set period (e.g. 15 minutes) and ensure that the option, On resume, display logon screen is checked. And, if you're prone to nodding off while watching movies, use a video player that allows you to keep the screensaver enabled. In VLC, for example, you would uncheck the Disable screensaver setting.
However, if you're using software that disables the screensaver and doesn't have an option to leave it enabled, then you may need a script like the one below. This is an HTA that displays a countdown for whatever timeout you set in the script and logs you out when the countdown reaches zero. Whenever you click the Reset Countdown button (or press F5), it resets the countdown back to the timeout value.
This should suffice as a "doze guard". There's no point in prompting for a password unless you want to ensure no one else can mess with the countdown (including not being able to just kill the task). If that's the case, you will need something more sophisticated, such as this package and be logged in as a standard user while running it.
The script below works best if you have at least two monitors, so that your movie, stream, whatever can be on one screen and DozeGuard can be on another.
DozeGuard.hta
<!DOCTYPE html>
<html>
<title>DozeGuard</title>
<head>
<meta charset="UTF-8" http-equiv="X-UA-Compatible" content="IE=9">
<hta:application
icon=perfmon.exe
scroll=no
contextmenu=no
showintaskbar=yes
singleinstance=yes
SysMenu=yes
>
<script language="VBScript">
Const DefaultWait = 15 'minutes
Set oWSH = CreateObject("Wscript.Shell")
Dim TimeLeftInSeconds,WaitTimer
logoutcmd = "Shutdown.exe -l -f"
Scale = GetScale()
w = 300 * Scale: h = 150 * Scale
Window.ResizeTo w, h
Window.MoveTo (screen.availWidth - w)/2, (screen.availHeight - h)/2
TimeLeftInSeconds = DefaultWait * 60
Sub window_onLoad
UpdateCountdown
WaitTimer = Window.SetInterval("UpdateCountdown()", 1000)
End Sub
Sub UpdateCountdown
If Not Paused Then
Hours = CInt(TimeLeftInSeconds \ 3600)
Minutes = CInt((TimeLeftInSeconds Mod 3600) \ 60)
Seconds = TimeLeftInSeconds Mod 60
CountDown.innerHTML = Hours & ":" & Right("0" & Minutes,2) & ":" & Right("0" & Seconds,2)
If TimeLeftInSeconds<0 Then
oWSH.Run logoutcmd,1,False
self.Close
Exit Sub
End If
TimeLeftInSeconds = TimeLeftInSeconds - 1
End If
End Sub
Sub ResetCountDown
TimeLeftInSeconds = DefaultWait * 60
End Sub
Function GetScale()
GetScale = 1.0
On Error Resume Next
'If user changes scale, they must logout/login for this registry value to change
GetScale = oWSH.RegRead("HKCU\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 96
On Error Goto 0
End Function
</script>
<style>
body {background-color:black; font-family:Segoe UI; font-size:11pt}
h1 {color:red}
.timerDiv {text-align:center}
</style>
</head>
<body>
<div class=timerDiv>
<h1 id=CountDown></h1>
<input type=button value='Reset Countdown' OnClick=ResetCountDown()>
</div>
</body>
</html>

Related

VBScript waiting till button is clicked

I am new to VBScript and trying to measure the performance of a website I have created. In my website, when a button is clicked, that item will be added to a shopping cart. There are 6 items to be added to the cart. If my script click the first item to be added to the cart, I want it to wait till proceeding to the next instruction (without putting a random sleep number). In my program, it only adds the 1st and the last item to my cart:
set webbrowser = createobject("internetexplorer.application")
webbrowser.visible = true
webbrowser.navigate("https://www.mywebsite")
Do While webbrowser.busy 'waiting till the webpage is loaded
wscript.sleep(1)
Loop
buttonID = "item1"
Demo(buttonID)'Program should wait till the first button is clicked before going to the statement below'
buttonID = "item2"
Demo(buttonID)
buttonID = "item3"
Demo(buttonID)
buttonID = "item4"
Demo(buttonID)
buttonID = "item5"
Demo(buttonID)
buttonID = "item6"
Demo(buttonID)
Sub Demo(buttonID)
Do
set x = webbrowser.Document.getElementById(buttonID)
If x is nothing then
wscript.sleep 1
else
webbrowser.Document.getElementById(buttonID).click
Exit Do
end if
Loop
End Sub
You can do something like this:
set objie = createobject("internetexplorer.application")
objie.visible=true
objie.Navigate "https://www.swrm2017.org/TimeMeasurementOnlineShoppingSystem/BrowseCatalog/Catalog.php"
swait()
for i = 1 to 6
id = "item"&i
set button = objie.document.getElementById(id)
button.click
swait()
set button = nothing
next
set ie = nothing
sub swait()
while(objie.readystate<>4)
wscript.sleep 10
wend
while objie.document.readystate<>"complete"
wscript.sleep 10
wend
end sub

Is it possible to add a hourglass to the cursor?

I want a vbscript.vbs that will add a hourglass to the cursor or completely changes the cursor into hourglass and cursor changes to standard mode at the end of script.
I searched Google a lot but didn't find anything.I haven't even tried a single line of code.
VBS doesn't include this functionality.
By default .vbs files are executed by the Windows Script Host, which doesn't provide a method for updating the cursor either. If you are using another host this may provide a method.
Assuming you are looking for a way to track the progress of your script there are some workarounds.
Method 1
Executing your script via the command line provides a UI, which you output progress to.
Method 2
Wrap your VBScript inside a HTA. This will provide a one page HTML UI. You could include some sort of progress indicator here.
As he said "destination-data" ==> VBS doesn't include this functionality.
But if you wrap your VBScript inside a HTA, you can found a workaround for this
Here is an example in HTA found here
<HTML>
<HEAD>
<STYLE>
.clsAccKey:first-letter {text-decoration: underline}
BUTTON {width: 15ex}
</STYLE>
<SCRIPT language=VBScript>
Option Explicit
Sub btnClick_onclick()
btnClick.disabled = True
document.body.style.cursor = "wait"
btnClick.style.cursor = "wait"
'Long delay here just to simulate a long
'running process visually for this demo.
setTimeout "HiThere", 2000, "VBScript"
End Sub
Sub HiThere()
document.body.style.cursor = "default"
btnClick.style.cursor = "default"
MsgBox "Hi There!"
btnClick.disabled = False
End Sub
</SCRIPT>
</HEAD>
<BODY>
<BUTTON id=btnClick accessKey=C class=clsAccKey>Click Me</BUTTON>
</BODY>
</HTML>
And i used it in this example : Execution a powershell file with HTA
<html>
<head>
<title>Execution a powershell file with HTA by Hackoo</title>
<HTA:APPLICATION
APPLICATIONNAME="Execution a powershell file with HTA by Hackoo"
SCROLL="yes"
SINGLEINSTANCE="yes"
WINDOWSTATE="maximize"
ICON="Winver.exe"
SCROLL="no"
/>
<script language="VBScript">
Option Explicit
Sub Run_PS_Script()
ExampleOutput.value = ""
btnClick.disabled = True
document.body.style.cursor = "wait"
btnClick.style.cursor = "wait"
Dim WshShell,Command,PSFile,return,fso,file,text,Temp
Set WshShell = CreateObject("WScript.Shell")
Temp = WshShell.ExpandEnvironmentStrings("%Temp%")
Command = "cmd /c echo Get-WmiObject Win32_Process ^| select ProcessID,ProcessName,Handle,commandline,ExecutablePath ^| Out-File %temp%\output.txt -Encoding ascii > %temp%\process.ps1"
PSFile = WshShell.Run(Command,0,True)
return = WshShell.Run("powershell.exe -ExecutionPolicy Unrestricted -File %temp%\process.ps1", 0, true)
Set fso = CreateObject("Scripting.FileSystemObject")
Set file = fso.OpenTextFile(Temp &"\output.txt", 1)
text = file.ReadAll
ExampleOutput.Value=text
file.Close
document.body.style.cursor = "default"
btnClick.style.cursor = "default"
btnClick.disabled = False
End Sub
</script>
</head>
<body bgcolor="123456">
<textarea id="ExampleOutput" style="width:100%" rows="37"></textarea>
<br>
<center><input type="button" name="btnClick" value="Run powershell script file " onclick="Run_PS_Script()"></center>
</body>
</html>

How to Zoom in or Zoom out in a webpage while using UFT/QTP

I would like to control the zoom in and out feature of my webpage of the application under test using UFT. This is required as the zoom level changes dynamically and it becomes difficult to identify the objects.
I have found a code but it is useful if you need to change the zoom level at one instance or at the start. below is the code
Function ChangeIEZoom
Dim intZoomLevel, objIE
intZoomLevel = 110
Const OLECMDID_OPTICAL_ZOOM = 63
Const OLECMDEXECOPT_DONTPROMPTUSER = 2
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Visible = True
objIE.Navigate ("www.google.com")
While objIE.Busy = True
wait 5
Wend
objIE.ExecWB OLECMDID_OPTICAL_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, CLng(intZoomLevel), vbNull
End Function
with this code, it opens up a new browser and navigates it to a URL.
I do not want it to create a new instance of the browser.
What I need is that it changes the zoom level on the same page which is already under test execution, also the page where zoom level change is required not known at the start and it may or may not require change based on the fact that it identifies certain objects.
Has anyone faced the same issue or has a solution to it ?
I found a solution - combining what you mentioned in comments. this works if you want to change the zoom level on current webpage you are working on. helps when you want to zoom in and out at multiple instances
Dim ShellApp
Set ShellApp = CreateObject("Shell.Application")
Dim ShellWindows
Set ShellWindows = ShellApp.Windows()
Dim intZoomLevel
intZoomLevel = 110
Const OLECMDID_OPTICAL_ZOOM = 63
Const OLECMDEXECOPT_DONTPROMPTUSER = 2
Dim i
For i = 0 To ShellWindows.Count - 1
If InStr(ShellWindows.Item(i).FullName, "iexplore.exe") <> 0 Then
Set IEObject = ShellWindows.Item(i)
End If
If IEObject.Visible = True Then
While IEObject.Busy = True
wait 5
Wend
IEObject.ExecWB OLECMDID_OPTICAL_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, CLng(intZoomLevel), vbNull
End If
Next
print "it works"

Saving snapshot using vbscript

I am new to vbscript. I want to save a snapshot taken using vbscript of a internet explorer window opened by vbscript.
Code to load the page
Dim IE, stateString
Set IE = WScript.CreateObject("InternetExplorer.Application")
ie.toolbar = 1
ie.statusbar = 1
ie.width = 999
ie.height = 500
ie.left = 20
ie.theatermode = false
ie.theatermode = true
ie.theatermode = false
ie.top = 50
ie.navigate("file:///C:\Users\Vinit_Tiwari\Documents\vbscripts\someform.html")
'stateString = cstr(ie.readystate)
waitforload(ie)
ie.visible = 1
Set wshShell = CreateObject("Wscript.Shell")
wshShell.AppActivate "Some Form"
wshShell.SendKeys "% x"
Code to take snapshot
Dim oWordBasic
set oWordBasic = CreateObject("Word.Basic")
oWordBasic.sendkeys "{prtsc}"
oWordBasic.AppClose "Microsoft Word"
Set oWordBasic = Nothing
Wscript.Sleep 2000
Saving the snapshot
dim paint
set paint = wshShell.exec("mspaint")
do while paint.status = 0:loop
wshShell.appactivate("untitled-Paint")'this returns false
Wscript.sleep 500
WshShell.SendKeys "^v"
wscript.sleep 500
wshshell.sendkeys "^s"
wscript.sleep 500
wshshell.sendkeys "d:\test.png"
wscript.sleep 500
wshell.sendkeys "{Enter}"
Set wshshell = Nothing
Actually the previously opened ie window is having focus and the keystrokes are sent to the ie instead of paint. so is there any function which performs opposite work of AppActivate.
This won't work. Microsoft Word is in focus while the Print Screen button is pressed. You can easily eliminate this problem by not using Microsoft Word at all. It's not necessary. The Print Screen function is a system hotkey and has nothing to do with Microsoft Word. You should be using the Alt+PrintScreen combination which captures a screenshot of the currently focused window to the clipboard.
Second, if Paint is not in focus instead of IE, it's because you have the window title wrong. You are doing that part correctly. AppActivate returns false if it cannot find a window with the specified title. To be honest, Paint should alread have focus to begin with but it is good practice to make sure the window is activated first.
Also, is this a very old system? Why are you using the Word.Basic automation object anyway out of curiosity?

Clicking on a link that contains a certain string in VBS

I'm trying to run an automated vbs script that clicks on a link on a page. I have things of the form:
Const READYSTATE_COMPLETE = 4
Set IE = CreateObject("INTERNETEXPLORER.APPLICATION")
IE.Visible = true
IE.navigate ("http://mywebpage.com")
How do I then make it click on a link on that page that doesn't have an ID but is like
ClickMe!
Thanks!
Along the lines of
Dim LinkHref
Dim a
LinkHref = "link"
For Each a In IE.Document.GetElementsByTagName("A")
If LCase(a.GetAttribute("href")) = LCase(LinkHref) Then
a.Click
Exit For ''# to stop after the first hit
End If
Next
Instead of LCase(…) = LCase(…) you could also use StrComp(…, …, vbTextCompare) (see StrComp() on the MSDN).

Resources