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

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

Related

Loading on-the-fly listbox produces duplicate entries

Onload, this HTA lists the files contained in FolderX and presents their names in a listbox. When I select a file, the second listbox should list the file records (simple text items - itemA, itemB, for example). Instead it lists the records twice with a space between the first and second sets. The msgbox seems to show that I am making two trips through FLFLBox_onChange. Why is that happening?
I don't want to de-select the file as that shows which file I am seeing the records for (yes, I could put that into another box, but is that the problem)?
Thanks.
<HTA:APPLICATION ID="FilelistBuilder" BORDER="thin" BORDERSTYLE="complex" maximizeButton="yes" minimizeButton="yes" />
<script language=vbscript>
option explicit
dim forReading, forWriting
forReading = 1
forWriting = 2
dim strNewFile, objFSO, objFile, objFiles, strLine, objOption, oFile, colFiles, objFolder
dim objShell, oExec, strWD,intFileCount
dim strTargetFLFL
strTargetFLFL = "C:\FolderX"
Sub Window_Onload
'Creates an on-the-fly listbox of files
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.getFolder(strTargetFLFL)
set colFiles = objFolder.files
intFileCount = 0
For Each oFile in colFiles
strLine = ofile.name
Set objOption = Document.createElement("OPTION")
objOption.Text = strLine
objOption.Value = strLine
FLFLBox.Add(objOption)
intFileCount = intFileCount +1
Next
End Sub
Sub FLFLBox_onChange
'Creates an on-the-fly list of file contents for selected file
dim strTargetFL, strContents, arrContents, ContentRecord
strTargetFL = strTargetFLFL & "\" & FLFLBox.value
msgbox "File Name: " & strTargetFL
Set objFile = objFSO.OpenTextFile(strTargetFL,forReading)
strContents = objFile.ReadAll
arrContents = split(strContents,vbnewline)
For Each ContentRecord in arrContents
Set objOption = Document.createElement("OPTION")
objOption.Text = ContentRecord
objOption.Value = ContentRecord
FLBox.Add(objOption)
Next
End Sub
sub Close_onclick
msgbox "The application will exit and any unsaved data will be lost"
window.close
end sub
</script>
</head>
<body>
<h1> ARPA </h1>
<h2> File List Builder</h2>
<BR>
<input type="button" name=Close value="Close">
<br>
<p>
</p>
</div>
<div id="Action style="position:absolute;top:10%;left:30%">
</div>
<div style="position:absolute;top:5%;left:60%">
List of Files - Click to List Contents;
</div>
<div id="FileListFileList" style="position:absolute;top:10%;left:60%;right:100%">
<select listbox name="FLFLBox" size="5" onChange="FLFLBox_OnChange">
</select>
</div>
<div style="position:absolute;top:30%;left:60%">
List File Contents
</div>
<div id="OneFileList" style="position:absolute;top:35%;left:60%;right:100%">
<select listbox name="FLBox" size="10">
</select>
</div>
<div id="FileEdit" style="position:absolute;left:60%">
</div>
</form>
</body>
</html>
You don't need the onChange="FLFLBox_OnChange" in your select tag as the function FLFLBox_OnChange runs without it because of the name that you have given to it. Having it in the select tag causes it to run twice.
Change
<select listbox name="FLFLBox" size="5" onChange="FLFLBox_OnChange">
to
<select listbox name="FLFLBox" size="5">

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>

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

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>

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>

Resources