Close an HTA when the user presses the 'Esc' key - vbscript

I'm trying to capture key presses so that I can close my HTA when the user presses the Esc key.
I have confirmed that the onKeyUp event works (I also capture the length of an input), and also that the example below is not working (by adding a MsgBox which is not fired).
What am I missing here?
Sub window_onKeyUp()
If window.event.keyCode = 27 Then
Call CloseHTA()
End If
End Sub

This works for me.
<script language="VBScript">
Sub TestKey()
intKeyCode = Window.Event.Keycode
If intKeyCode = 27 Then Window.Close
End Sub
</script>
<body onkeyup="TestKey">
</body>
Edit:
Alternatively, you can use Document_OnKeyUp() if you want to include your code after the <body> tag.
<body>
</body>
<script language="VBScript">
Sub Document_OnKeyUp()
intKeyCode = Window.Event.Keycode
If intKeyCode = 27 Then Window.Close
End Sub
</script>

You can try like this :
<html>
<script language="VBScript">
Sub TestKey()
intKeyCode = Window.Event.Keycode
If intKeyCode = 27 Then Call CloseHTA()
End Sub
Sub CloseHTA()
self.close
End Sub
</script>
<body onkeyup="TestKey">
</body>
</html>

Related

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>

SetTimeout() won't execute the function

So this is my code snippet:
'in VBScript
Sub Main()
Dim timeoutTimer
'more scripts here
'more scripts here
'more scripts here
timeoutTimer = window.setTimeout("alert()", 2000)
Call WaitForAnEvent() 'This function waits for an event to happen
'if there is no event then code execution stop's
'and wait
'more scripts here
'more scripts here
'more scripts here
End Sub
Sub alert()
MsgBox "Help!"
End Sub
What happens is, there are times when alert() is not triggered, and I don't have any idea why. I conducted some research about setTimeout() and they said that setTimeout will be triggered if the timer expires and as soon as there is an available opportunity to execute it. I believe after WaitForAnEvent() is invoked there will be an available opportunity for setTimeout to be executed but
sometimes it is and sometimes it is not.
Update -------------------------------------------------------------------------------
I had been reading a lot of articles about setTimeout and they all say(in short) that it cannot be triggered if the browser is busy doing something.
Now:
Is it correct to assume that the browser is doing something(infinite), and
setTimeout cannot find an available moment to trigger the function?
Is there a way in VBScript/Javascript to check if IE(browser) is currently doing somthing like rendering text or executing some scripts?
I think you should change your function name from alert to something that does not collide with elements exposed by the browser (there is a window.alert() function). Maybe this will work as is (not tested), but it is better to avoid confusion
The proper syntax to bind the event to the handler is to retrieve a reference to the function (here renamed)
window.setTimeout(GetRef("showAlert"), 2000)
Probably because I don't have enough information, but I don't see the need for your WaitForAnEvent() function. Events happen. You bind the function to execute on event and leave to the browser the work to call the event handler when needed
edited Just for a sample (adapted from a previous answer)
In this HTA, there are five events being handled: Start button press, Stop button press, Exit button press, Clock interval and File existence check
The basic idea is NOT to have code running all the time. The browser has the control and when an event happens (button pressed or interval reached) the code to handle the event is called and ends.
<html>
<head>
<title>ClockwithAlerts</title>
<HTA:APPLICATION
ID="ClockHTA"
APPLICATIONNAME="ClockHTA"
MINIMIZEBUTTON="no"
MAXIMIZEBUTTON="no"
SINGLEINSTANCE="no"
SysMenu="no"
BORDER="thin"
/>
<SCRIPT LANGUAGE="VBScript">
Const TemporaryFolder = 2
Dim timerID, timerFile
Sub Window_onLoad
window.resizeTo 600,280
SetClockTimer True
timerFile = window.setInterval(GetRef("CheckFilePresence"), 1500)
End Sub
Sub CheckFilePresence
Dim myFile
With CreateObject("Scripting.FileSystemObject")
myFile = .BuildPath(.GetSpecialFolder( TemporaryFolder ), "test.txt")
If .FileExists(myFile) Then
fileStatus.innerText = "FILE ["& myFile &"] FOUND"
Else
fileStatus.innerText = "File ["& myFile &"] is not present"
End If
End With
End Sub
Sub SetClockTimer( Enabled )
If Enabled Then
timerID = window.setInterval(GetRef("RefreshTime"), 1000)
RefreshTime
Else
window.clearInterval(timerID)
timerID = Empty
End If
StartButton.disabled = Enabled
StopButton.disabled = Not Enabled
End Sub
Sub RefreshTime
CurrentTime.InnerHTML = FormatDateTime(Now, vbLongTime)
End Sub
Sub ExitProgram
If Not IsEmpty(timerID) Then window.clearInterval(timerID)
If Not IsEmpty(timerFile) Then window.clearInterval(timerFile)
window.close()
End Sub
</SCRIPT>
</head>
<body>
<input id="checkButton" type="button" value="EXIT" name="run_button" onClick="ExitProgram" align="right">
<br><br>
<span id="CurrentTime"></span>
<br><br>
<input id="Stopbutton" type="button" value="Stop" name="StopButton" onclick="SetClockTimer(False)">
<input id="StartButton" type="button" value="Start" name="StartButton" onclick="SetClockTimer(True)">
<hr>
<span id="fileStatus"></span>
</body>
</html>
try remove quotes around your function name:
timeoutTimer = window.setTimeout(alert, 2000)

Dual Time Display, 1 with Toggle Pause, and Msgbox Sub at 1115a, 245p, and 530p

Below is my hta that I've been trying to figure out how to show only the TIME with a stop and go button. What I am trying to accomplish is (1. fixing the start subroutine, starting hta all works fine, after I push "STOP" followed by "START" the clock does NOT refresh continuously), (2. making a single toggle button to pause/unpause the time), (3. displaying a second TIME that just keeps on counting), and (4. setting msgbox sub with diff messages to run at 6 specific times, the specific times 1115a, 245p, 530p, and 5 minutes before each of the times are reached.) Thank you much for your time and consideration.
<html>
<head>
<title>ClockwithAlerts</title>
<HTA:APPLICATION
ID="ClockwithAlerts"
APPLICATIONNAME="ClockwithAlerts"
MINIMIZEBUTTON="no"
MAXIMIZEBUTTON="no"
SINGLEINSTANCE="no"
SysMenu="no"
BORDER="thin">
<SCRIPT LANGUAGE="VBScript">
Sub Window_onLoad
window.resizeTo 400,200
timerID = window.setInterval("RefreshTime", 1000) 'milliseconds
RefreshTime
End Sub
Dim timerID
Sub RefreshTime
CurrentTime.InnerHTML = Now
End Sub
Sub OnClickButtonStop()
window.clearInterval(timerID)
End Sub
Sub ExitProgram
window.close()
End Sub
</SCRIPT>
</head>
<body>
<input id="checkButton" type="button" value="EXIT" name="run_button" onClick="ExitProgram" align="right">
<br><br>
<span id="CurrentTime"></span>
<br><br>
<input id="Stopbutton" type="button" value="Stop" name="Stopbutton" onclick="OnClickButtonStop">
<input id="Stopwatch" type="button" value="Start" name="Stopbutton" onclick="refreshtime">
</body>
</html>
Your
<input id="Stopwatch" type="button" value="Start" name="Stopbutton" onclick="refreshtime">
calls refreshtime just once. You need to call a
Sub OnClickButtonStart()
timerID = window.setInterval("RefreshTime", 1000) 'milliseconds
RefreshTime
End Sub
that starts the timer again. This Sub can be re-used in
Sub Window_onLoad
window.resizeTo 400,200
OnClickButtonStart
End Sub

A Game Exit Menu

I need some help with a quick question.I have a HTA Application that is the menu for a game I am making, here is the problem, I have a exit button, but when you click it, it just closes the program, but what I want is to make it so when you click the exit button, a VBS dialog box pops up and asks, "Are you sure you want to exit the game?", with yes or no buttons, can anyone help me?
Thanks :D
Make the procedure called by your exit button look like this:
Sub ExitHTA
answer = MsgBox("Are you sure?", vbYesNo)
If answer = vbYes Then self.close()
End Sub
If you want you can put the application name as the message box title like this:
<html>
<title>My Game</title>
<HTA:APPLICATION ID="oHTA"
APPLICATIONNAME="My Game"
...
>
<script language="VBScript">
...
Sub ExitHTA
answer = MsgBox("Are you sure?", vbYesNo, oHTA.ApplicationName)
If answer = vbYes Then self.close()
End Sub
</script>
<body>
...
<input type="button" id="exitbtn" onClick="vbscript:ExitHTA" value="Exit">
...
</body>

Textbox in HTA after text is submitted, remove text from textbox

not sure if this has been asked anywhere, (I cant find it)...
I made a little simple Google Search HTA file...
it works great no issue really but I want the text to disappear after ive pressed enter ?
I tried BasicTextBox.Value = "" after the search ...but this takes everything anyway except the last letter..
I hope im making sense, can someone help me please ?
<html>
<head>
<title>Search Google</title>
<HTA:APPLICATION
ID="objHTAHelpomatic"
border="thin"
borderStyle="normal"
caption="yes"
maximizeButton="no"
minimizeButton="no"
showInTaskbar="yes"
windowState="normal"
innerBorder="no"
navigable="no"
scroll="no"
scrollFlat="no"
sysMenu="yes"
icon="htaicon.ico"
>
</head>
<SCRIPT Language="VBScript">
Sub Window_OnLoad
window.resizeTo 100, 100
End Sub
sub checkEnter
With document.parentWindow.event
if .keycode = 13 then
Const NORMAL_WINDOW = 1
Set objShell = CreateObject("Shell.Application")
objShell.ShellExecute "https://www.google.com.au/search?q=" & BasicTextBox.Value
Else
.cancelbubble = false
.returnvalue = true
End if
End With
call removetext
End sub
sub removetext
BasicTextBox.Value = ""
end sub
</SCRIPT>
<body bgColor="gray" STYLE="font:8pt arial; color:white">
Search Google
<input type="text" onKeydown=checkEnter name="BasicTextBox" size="10">
</body>
</html>
Just call removetext in checkEnter:
sub checkEnter
Const NORMAL_WINDOW = 1
With document.parentWindow.event
if .keycode = 13 then
Set objShell = CreateObject("Shell.Application")
objShell.ShellExecute "https://www.google.com.au/search?q=" & BasicTextBox.Value
call removetext
End if
End With

Resources