Loading on-the-fly listbox produces duplicate entries - vbscript

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">

Related

Submitting Google Form with VBS

<input type="text" class="quantumWizTextinputPaperinputInput exportInput" jsname="YPqjbf"
autocomplete="off" tabindex="0" aria-label="Untitled question"
aria-describedby="i.desc.608035577 i.err.608035577"
name="entry.1790931838" value="" required="" dir="auto" data-initial-dir="auto"
data-initial-value="" aria-invalid="true">
The above is the HTML code of the input box which I would like to automatically fill with VBS.
<span jsslot="" class="appsMaterialWizButtonPaperbuttonContent exportButtonContent"><span class="appsMaterialWizButtonPaperbuttonLabel quantumWizButtonPaperbuttonLabel exportLabel">Submit</span></span>
And the above is the code for the submit button.
On Error Resume Next
Const PAGE_LOADED = 4
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Navigate("https://docs.google.com/forms/d/e/1FAIpQLScOmcmtdsrm3RiX7FD9ur2eLPULL9ZulSzKxjG87BblRky7hQ/viewform")
objIE.Visible = True
WScript.Sleep(3000)
IE.Document.getElementById("entry.1790931838").Value = "msdasdadm"
This is my code to auto-fill the form however I have not seemed to make it work. Also, I am not able to understand how to call the submit button and press that either.
This should get you started...
On Error Resume Next
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Navigate("https://docs.google.com/forms/d/e/1FAIpQLScOmcmtdsrm3RiX7FD9ur2eLPULL9ZulSzKxjG87BblRky7hQ/viewform")
objIE.Visible = True
WScript.Sleep(3000)
Dim input, inputs : Set inputs = objIE.document.getElementsByTagName("INPUT")
For Each input In inputs
If ("text" = input.getAttribute("type")) Then
input.value = "Just a test"
Exit For
End If
Next
Dim div, divs : Set divs = objIE.document.getElementsByTagName("DIV")
For Each div In divs
If ("button" = div.getAttribute("role") And "M2UYVd" = div.getAttribute("jsname")) Then
Call div.click()
Exit For
End If
Next
The Submit button is actually a parent DIV element with an associated JS onclick event handler defined. However, keep an eye on the jsname attribute, as the random name will most likely change between forms.
Hope this helps.

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>

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

Calling multiple functions from single onClick in VBScript

I have created a VBScript function that allows users to install a network printer by clicking a button. This works great, but there is no feedback after clicking the button. I'm trying to add an alert after the button is clicked, but I'm having trouble with the syntax.
Here is the functioning onClick function for installing a printer:
<script type="text/vbscript">
function AddP(pName)
Set WshNetwork = CreateObject("Wscript.Network")
WshNetwork.AddWindowsPrinterConnection pName
end function
</script>
<td><input name="Button1" type="button" value="Add"></td>
If you want to give the user some indication something is happening while the printer is being added you could change the button state.
<script type="text/vbscript">
function AddP(pName)
Dim allButton1s
Set allButton1s = document.getElementsByName("Button1")
allButton1s(0).value = "Please wait..."
Set WshNetwork = CreateObject("Wscript.Network")
WshNetwork.AddWindowsPrinterConnection pName
MsgBox "Printer Added"
allButton1s(0).value = "Add"
end function
</script>
Simplest solution: Add a colon to your declaration which acts as a statement separator. This will allow you to call an additional function.
<a href="#" language="vbscript" onclick="AddP('\\PrinterName': msgbox 'Printer added')">
Just add this line after your WshNetwork.AddWindowsPrinterConnection line
MsgBox "Printer Added"

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