VBScript/HTA Application - Running multiple programs at once chosen by user - vbscript

So here is what i am wondering about boys and girls - first of all i am a complete noob to this, LITERALLY just starting so don't go too hard on me. I have a bunch of code i wrote, to make a .HTA application:
> <html> <head>
>
> <script type="text/vbscript">
>
> Dim objShell Sub Button1_OnClick()
>
> if box2.checked AND box1.checked then
>
> Set objShell = CreateObject( "WScript.Shell" )
> objShell.Run("""%programfiles(x86)%\Mozilla Firefox\firefox.exe""")
> Set objShell = Nothing
>
> Set objShell = CreateObject( "WScript.Shell" ) objShell.Run("cmd.exe")
> Set objShell = Nothing
>
> elseif box1.checked then
>
> Set objShell = CreateObject( "WScript.Shell" ) objShell.Run("cmd.exe")
> Set objShell = Nothing
>
> Elseif box2.checked then
>
> Set objShell = CreateObject( "WScript.Shell" )
> objShell.Run("""%programfiles(x86)%\Mozilla Firefox\firefox.exe""")
> Set objShell = Nothing
>
>
> End If End Sub
>
>
> </script> </head> <body> <font face=Calibri> Check the program you
> would like to run! <br> Available programs to run for now: <br> <input
> type="checkbox" name="box1">CMD <br> <input type="checkbox"
> name="box2">Mozilla <br> <i>Choose which program(s) you'd like to run.
> It is possible to run multiple programs at one time!</i></font><br>
> <input type="button" name="btn1" onclick="Button1_OnClick"
> value="Submit"><br> <div id="error"></div>
>
>
>
> </body> </html>
This works perfectly as it is supposed to, when i check both programs, both of them will run, when i check one of them, only one will run. But what if i have like 50 different programs on that list? I suppose there is a simplier way to write this than writing load of if/else/elseif statements for each program combination? As mentioned above im complete noob to this, maybe i simply haven't discovered an easier way yet... But that's also why i ask.

You can use the elements attributes for your purpose.
Iterate over all the checkboxes, then start the process using its path stored in your custom attribute if it's checked. Done.
<html>
<head>
<script type="text/vbscript">
Dim objShell
Set objShell = CreateObject("WScript.Shell")
Sub StartProcesses
Dim Checkbox
For Each Checkbox In Document.getElementsByName("process")
If Checkbox.Checked Then
objShell.Run """" & Checkbox.getAttribute("path") & """"
End If
Next
End Sub
</script>
</head>
<body>
<font face=Calibri>
Check the program you would like to run! <br>
Available programs to run for now: <br>
<div id="ProcessList">
<input type="checkbox" name="process" path="cmd.exe">CMD <br>
<input type="checkbox" name="process" path="iexplore.exe">Internet Explorer <br>
<input type="checkbox" name="process" path="%programfiles(x86)%\Mozilla Firefox\firefox.exe">Firefox <br>
<input type="checkbox" name="process" path="calc.exe">Calculator <br>
<input type="checkbox" name="process" path="notepad.exe">Notepad <br>
</div>
<i>Choose which program(s) you'd like to run. It is possible to run multiple programs at one time!</i>
</font><br>
<input type="button" onclick="StartProcesses" value="Submit"><br>
<div id="error"></div>
</body>
</html>

Related

Way to close child HTA file if it gets called again from a parent HTA file

I want to run a HTA file where, there is a loop in which the parent HTA calls a child HTA to display an update on a regular interval. I want the child HTA to be remain open with old update and it should close when it is called again with new update and diplay it. I tried to do it, but I am unable to add close HTA condition on the child HTA. Which results in all Child HTA opened in the background.
Parent HTA File,
Code given below
<html>
<head>
<title>Parent Application</title>
<HTA:APPLICATION
APPLICATIONNAME="Parent Application"
ID="ParentApplication"
VERSION="1.0"/>
</head>
<script language="VBScript">
Sub OnClickButtonConnect()
Dim currentDirectory,pos
pos=InStrRev(document.location.pathname,"\")
currentDirectory=""
If pos>0 Then
currentDirectory = Left(document.location.pathname,pos)
End If
Dim WshShell, i, g
g = 5
set WshShell = CreateObject("wscript.Shell")
For i = 1 To g
cmdline = "mshta.exe """ & currentDirectory & "child.hta"" """ & login.value & """ """ & password.Value & """"
WshShell.Run cmdline,1,False
next
window.close
End Sub
</script>
<body bgcolor="white">
<!--Add your controls here-->
Login:<input type="text" name="login" id="login"><BR>
Password:<input type="password" name="password" id="password"><BR>
<input type="button" name="Connect" id="Connect" value="Connect" onclick="OnClickButtonConnect">
<!--{{InsertControlsHere}}-Do not remove this line-->
</body>
</html>
Child HTA
<html>
<head>
<title>Child Application</title>
<HTA:APPLICATION
APPLICATIONNAME="Child Application"
ID="ChildApplication"
VERSION="1.0"/>
</head>
<script language="VBScript">
Sub Window_OnLoad
str=""
arguments = Split(ChildApplication.CommandLine," """)
For i=0 To UBound(arguments)
arguments(i)=Replace(arguments(i),"""","")
Next
document.body.innerhtml="login is: " & arguments(1) & "<BR>password is: " & arguments(2)
End Sub
</script>
<body bgcolor="white">
<!--Add your controls here-->
<!--{{InsertControlsHere}}-Do not remove this line-->
</body>
</html>
Call this Sub before opening the child hta. Make sure the name of the hta matches its actual name.
Sub CloseChild
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colProcessList = objWMIService.ExecQuery _
("Select CommandLine from Win32_Process where CommandLine like '%child.hta%'")
For Each objProcess In colProcessList
objProcess.Terminate()
Next
End Sub
Edit: I just wanted to comment for anyone who may read this later. Putting CommandLine in the select statement is not explicitly required, even though this property is used in the where clause. You can select any or all of the properties in the Win32_Process class, including or excluding CommandLine.
I do suggest selecting only the properties you need to increase the speed of the query, and historically, for clarity, I select the same property as I use in the where clause if I don't actually need one.

Adding GUI in VBScript [duplicate]

This question already has answers here:
Adding a GUI to VBScript
(3 answers)
Closed 7 years ago.
I have a bunch of VBScripts and I wanted to have a GUI so that I don't have to double click the actual .vbs. Is there a way or other programming languages that can launch VBS and have GUI?
This is a console menu. Right click and choose Open in Command Prompt. Only options 3 and 5 do anything. This is from Filter's menu code at https://skydrive.live.com/redir?resid=E2F0CE17A268A4FA!121
Set Arg = WScript.Arguments
set WshShell = createObject("Wscript.Shell")
Set Inp = WScript.Stdin
Set Outp = Wscript.Stdout
Showmenu
Sub ShowHelpMenu
outp.writeline " -----------------------------------------------------------------------------"
outp.writeblanklines(1)
outp.writeline " Menu"
outp.writeline " ----"
outp.writeblanklines(1)
outp.writeline " 1 Help 2 HTML Help 3 Version 4 History"
outp.writeblanklines(1)
outp.writeline " 5 Exit"
outp.writeblanklines(1)
outp.write "Filter>"
End Sub
'=============================================
Sub ShowMenu
Do
ShowHelpMenu
Answ=Inp.readline
If Answ = "1" Then
ShowGeneralHelp "TEXT"
Elseif Answ = "2" Then
ShowGeneralHelp "HTML"
Elseif Answ = "3" Then
Version
Elseif Answ = "4" Then
History
Elseif Answ = "5" Then
Exit Do
End If
Loop
End Sub
'=============================================
Sub History
On Error Resume Next
WshShell.Run """" & FilterPath & "FilterHistory.txt""" , 1, False
err.clear
End Sub
'=============================================
Sub Version
outp.writeblanklines(1)
outp.writeline " Version"
outp.writeline " -------"
outp.writeblanklines(1)
outp.writeline " Filter Ver 0.6 - 2015 (Public Domain)"
outp.writeblanklines(1)
outp.writeline " by David Candy"
outp.writeblanklines(1)
End Sub
HTA or web pages give VBSript graphical ui. The main difference is HTA avoid security prompts. Although if you load a local web page, so do web pages. You program an HTA as if it's a web page.
Here's an HTA in HTML/VBScript, It uses a object that is a text database object.
<html>
<head>
<style>
BODY {font-size :100%;font-family: Arial, Helvetica, sans-serif;color: black;
background:URL(images/watermark.gif);background-color: white;
margin-top:0; margin-left:0pt; margin-right:0pt ; text-align:Justify}
P {margin-left:40pt;margin-right:10pt}
TABLE {font-size: 90%; text-align:left; margin-left:40pt;margin-right:10pt;background-color:lavender;width:90%}
THEAD {color: white;font-weight:bold;background-color:darkblue; margin-left:40pt;margin-right:10pt}
TD {Vertical-Align:Top;padding:3px}
</style>
</head>
<body>
<OBJECT CLASSID="clsid:333C7BC4-460F-11D0-BC04-0080C7055A83"
ID=dsoMacro5 WIDTH=0 HEIGHT=0>
<PARAM NAME="DataURL" VALUE="music.txt">
<PARAM NAME="UseHeader" Value="True">
<PARAM NAME="FieldDelim" VALUE=" ">
<PARAM NAME="Sort" Value="Title">
</OBJECT>
<h3>My Music Database</h3>
<h4>Select a button to filter list</h4>
<p>To search for a word in the Title field use <i>* word *</i>. To search for the first word in a field use <i>Word *</i> or the last word use <i>* word</i>. To search for a string within a word or word use <i>*partialword*</i>. Searches are case sensitive.</i></p>
<p><INPUT Name=tb1 TYPE=Text Value=""> <INPUT ID=cmdNavFirst TYPE=BUTTON VALUE=" Search " onclick="dsoMacro5.object.filter='Title=' + tb1.value;dsoMacro5.reset()"></p>
<p><INPUT ID=cmdNavFirst TYPE=BUTTON VALUE=" Sort Book " onclick="dsoMacro5.object.sort='Book';dsoMacro5.reset()"></p>
<hr class="body">
<TABLE ID=tblMacro2 DATASRC=#dsoMacro5 OnRowEnter=Alert(tblMacro2.row)>
<THEAD>
<TR>
<TD WIDTH="20%"><b>Number</b></TD>
<TD WIDTH="60%"><b>Title</b></TD>
<TD WIDTH="20%"><b>Book</b></TD>
</TR>
</THEAD>
<TBODY>
<TR>
<TD WIDTH="20%"><SPAN DATAFLD=Number></SPAN></TD>
<TD WIDTH="60%"><SPAN DATAFLD=Title></SPAN></TD>
<TD WIDTH="20%"><SPAN DATAFLD=Book></SPAN></TD>
</TR>
</TBODY>
</TABLE>
</body>
</html>
For this to work you need a database file called music.txt. Note that is TABS between fields.
Number Title Book
1 One A song
2 Two A another song
3 Three A yet another song
4 Four Yes it's a song
The first choice for a VBScript GUI is a HTA. All languages that can create a window/dialog and call external programs can run something like
P:\athto\corwscript.exe P:\ath\to\script.vbs pa ra me ters
So stick to HTA or pick the language you are most familiar with.

ASP script tags involving buttons within HTML

Have a question regarding scripts I've never worked on before. I am trying to get rid of two buttons that seem to be involved in the same script. Inside the body tags, I try to get rid of anything inside of the script, it'll break the page. Tried to do some research on it, but no luck.
This is inside the scripts section
HI, this is the section inside of the body tags
catid = Request.QueryString("id")
sub productInfo(connObj,category)
sqlCustomer = "SELECT * FROM qryProdsCategory WHERE ccategory = '" & Cint(category) & "'"
Set rs = Server.CreateObject ("adodb.Recordset")
rs.Open sqlCustomer, dbc, adOpenDynamic, adLockOptimistic, adCmdText
if not rs.EOF then
if Session("sort")="0" then
rs.sort = "cname ASC"
end if
while not rs.EOF
If rs("stock")="1" then
Response.Write "<form action="&q&Application("secureurl")&"/cart/view-cart.asp"&q&" method="&q&"POST"&q&" name=form"&i&">"
Response.Write "<a href=""product.asp?id=" & rs("catalogID") & ""
Response.Write "" & rs("catalogID") & "" & rs("manModNum") & "</font></td><td width=""18%"" rowspan=""2"">"
Response.Write "<input type="&q&"hidden"&q&" name="&q&"fproductid"&q&" value="&q & rs("catalogID")& q&">"
Response.Write "<input type="&q&"hidden"&q&" name="&q&"fquantity"&q&" value=1>"
Response.Write "<input type="&q&"hidden"&q&" name="&q&"fcat"&q&" value=" & rs("ccategory") & ">"
If rs("stock")="" then
Response.Write "<button class=""btn"" TYPE=""btn"" style=""background-color: #cb0000;color: #fff;"">.</button> </form>"
Else
Response.Write "<button "">ADD</button></form>"
End If
End If
rs.MoveNext
wend
else
Response.Write " <P><Center><font size=""2""><h3>Sorry, but products information for the category you have chosen is not available at this moment. Please check back soon!</H3></font></center>"
catname = "Error"
end if
end sub
%>
<!-- INSIDE BODY TAGS BELOW -->
<!-- Start Profile -->
<div class="span3">
<img src="img/team/profile1.jpg">
<div class="productSelection">
<div class="ProductTitle">
<strong style="font-size:16px;">LOREM IPSUM</strong>
</div>
<h6>LOREMIPSUM</h6>
<h6>LOREM IPSUM</h6>
<%
call openConn()
call productInfo(dbc,catid)
%>
</div>
</div>
<!-- End Profile -->
This is some bad code. The code is closing the form tag twice.
Since you say you only need one button, and since the form tag is either being closed twice or not at all, I think that one of the Response.Write statements needs to be in the other If branch.
'DONT TOUCH THESE BELOW
If rs("stock")="" then
Response.Write "<button class=""btn"" TYPE=""btn"" style=""background-color: #cb0000;color: #fff;"">ADD TO CART</button> </form>"
Else
Response.Write "<button "">ADD TO CART</button></form>"
'DONT TOUCH THESE ABOVE
End If

Classic ASP Intentional Wait / Delay inside Loop with Buffer Flushing

We have a script that sends emails and we want an intentional wait for n milliseconds between messages to not flood the server. The asp_Wait() I found works but without any output. That is, when the script is completely done running it dumps to the page.
My goal is to view each line in a browser as it is executed so I can monitor the progress of the script.
I have tried both with buffering ON and OFF with the same curious result (Server 2008 R2, IIS7). A test loop demonstrates this with a 1-second delay in the loop it will take n seconds to load the page, and I am putting Now() on each line to see when that loop executing (proving the wait is working), but I do not see a single line outputted during the script's execution.
<%
Dim IsBuffer ' this allows easy toggling of the buffer feature
IsBuffer = False
If IsBuffer Then Response.Buffer = True End If
Server.ScriptTimeout=7200 ' 2 hours (yes this is overkill!!)
i = 0
Response.Write "<h2>Test Page</h2><hr>"
If IsBuffer Then Response.Flush() End If ' flush the header
while i < 20
i = i + 1
Response.Write i & " at: " & Now() & "<br />" & VbCrLf
If IsBuffer Then Response.Flush() End If
Call asp_Wait(1000) ' milliseconds
wend
Response.Write "<br /><strong>**TOTAL OF " & i & " LOOPS.**</strong><br />" & vbCrLf
Sub asp_Wait(nMilliseconds)
Dim oShell
Set oShell= Server.CreateObject("WScript.Shell")
Call oShell.run("ping 1.2.3.4 -n 1 -w " & nMilliseconds,1,TRUE)
End Sub
%>
Thanks for your help!
I believe the default configuration for IIS7 enables GZIP compression. With compression enabled, ASP tends to ignore Response.Flush() statements.
Try following the instructions here to disable compression and see if that helps.
Edit: Found this as well.
I like to let the client handle delays by using redirect to a page that looks like this:
<%
ID_template= request.querystring("ID_template")
s_resume=request.querystring("resume")
s_file = "admin_email_send_go.asp?ID_template=" & ID_template
if (s_resume="yes") then s_file = "admin_email_send_resume.asp?ID_template=" & ID_template
%>
<html>
<head>
<meta http-equiv="Refresh" content="<%=int(session("n_records")/50)%>; url=<%=s_file%>">
<script type="text/javascript">
<!--
function delayer(){
document.location = "<%=s_file%>"
}
//-->
</script>
</head>
<body onLoad="setTimeout('delayer()',<%=int(session("n_records")*20)%>)" bgcolor='#FFFFFF'>
<br>
<table width='100%' height='100%'>
<tr>
<td valign=middle align=center>
<table border=1>
<tr>
<td>
Total list size: <%=session("n_records")%><br>
Sent so far: <%=session("n_records_sent")%>
</td>
</tr>
</table><br>
<br>
Sending next group of <%=application("email_group_size")%> in 2 seconds.<br>
Please wait...<br>
<br>
If you want to quit or pause the process at any time, click <a href='admin_email_send.asp?ID_template=<%=ID_template%>'>here</a>.<br>
<br>
</td>
</tr>
</table>
</body>
</html>
This code worked best for me:
<%
Private Function Delay(intSeconds)
StartTimed = Now()
CurrentTimed = Now()
While DateDiff("s",StartTimed,CurrentTimed) < intSeconds
CurrentTimed = Now()
Wend
End Function
Response.Write("This is now<br>")
call Delay(10)
Response.Write("This is 10 seconds later<br>")
%>

Create Sub-folder list when dropdown option is selected

I have a HTA code below which list all sub-folder in a specific folder.
My question is that if I click one sub-folder from list, how can it auto-create the second list that gives me all child-folder in that sub-folder? and so on till there is no more child-folder found, the last child-folder needs to list all files in it. Also how can I add a extra option in the end of each list called [new folder] that will pop-up a window allowing enter the name to create a new folder.
In the end if click [submit] button, It will open the last child-folder I choose in windows explorer.
I am new to vbs, so please help
<HEAD>
<TITLE>K Drive Program Structure</TITLE>
<HTA:APPLICATION ID="Hello"
APPLICATIONNAME="K Drive Program Structure"
BORDER="Dialog"
CAPTION="Yes"
SCROLL="NO"
SHOWINTASKBAR="yes"
SINGLEINSTANCE="yes"
SYSMENU="Yes"
WINDOWSTATE="maximize">
</HEAD>
<BODY>
<SCRIPT LANGUAGE="VBScript">
Sub UpdateList
For Each opt In list.Options
opt.RemoveNode
Next
Set fso = CreateObject("Scripting.FileSystemObject")
For Each f In fso.GetFolder("K:\AppData").SubFolders
Set opt = document.createElement("OPTION")
opt.Text = f.Name
opt.Value = f.Path
list.Add(opt)
Next
End Sub
</SCRIPT>
<H2>K Drive Structure</H2>
<P>CUSTOMER
<select id="list" name="list" onMouseOver="UpdateList"></select><P>
<BR>
<BR>
<Input Type = "Button" Name = "btn01" VALUE = "SUBMIT">
<Input Type = "Button" Name = "btn02" VALUE = "CLOSE">
<BR>
<BR>
</BODY>
Thanks for help
Why aren't you using the Shell.BrowseForFolder method like I suggested? Trying to re-invent it in HTA will always be awkward.
As for your question, you need to add an onChange handler to the <select> tag:
<select id="list" name="list" onMouseOver="UpdateList" onChange="EnumSubFolders">
</select>
and a procedure EnumSubFolders to enumerate the child folders:
Sub EnumSubFolders
Set fso = CreateObject("Scripting.FileSystemObject")
For Each opt In list.options
If opt.selected Then
Set sf = fso.GetFolder(opt.value).SubFolders
'do stuff with sf
Exit For
End If
Next
End Sub
You may need to apply some modifications to UpdateList, too (like remembering the currently selected option before refreshing the list).

Resources