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.
Related
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.
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
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>")
%>
I have a csv file (sample)
Firm,Code,Server
Adsuar,BZ,RKASP01
Ahlers,AU,RKASP02
Andrews,CW,RKASP02
Armbrecht,AS,RKASP02
Barron,ZZ,RKASP01
Beckman,BI,RKASP02
and am trying to find a way in vbscript to have a single select box on my website that lists the values of column A, and then populate two variables with the contents of column B and C in the same row.
I have what I need to read the csv file and can loop through the file and echo all the contents, however I'm having some trouble finding where to go from here. Any suggestions on where I can start would be appreciated.
The code I have currently is
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile("\\rkaspctl01\n$\wwwroot\dev\clients.csv", 1)
do while not (objTextFile.AtEndOfStream)
arrStr = Split(objTextFile.ReadLine, ",")
strFirm = arrStr(0)
strCode = arrStr(1)
strServer = arrStr(2)
Loop
objTextFile.close
Thanks
Patrick Stoddard
Start putting your data in a key/value pair (dictionary) where the key is the value from column A, the value is an array containing the values from column B and C:
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile("\\rkaspctl01\n$\wwwroot\dev\clients.csv", 1)
Set objFirmDict = CreateObject("Scripting.Dictionary")
do while not (objTextFile.AtEndOfStream)
arrStr = Split(objTextFile.ReadLine, ",")
objFirmDict.Add arrStr(0), array(arrStr(1), arrStr(2))
Loop
objTextFile.close
Now you can populate your listbox with the keys from the dictionary.
Pseudocode:
firmListbox = document.getElementById("firmSelect")
For each firm in objFirmDict.Keys
Set newOption = document.createElement("option")
newOption.text = firm
newOption.value = firm
firmListbox.Add newOption, Nothing
Next
When an option is selected, update the two variables with the correct text.
On you webpage:
<input type="select" id="firmSelect" onchange="vbscript:firmSelectChange me.Value">
The onchange event calls the firmSelectChange sub. This has to retrieve the two variables from the dictionary. Please note: The dictionary must have a global scope for the document.
Pseudocode for this handling sub:
Sub firmSelectChange(value)
dataArr = objFirmDict.Item(value)
code = dataArr(0)
server = dataArr(1)
End Sub
You can use TDC (Tabular Data Control).
<HTML>
<HEAD>
<TITLE>TDC Example</TITLE>
<OBJECT ID="dataTDC" CLASSID="CLSID:333C7BC4-460F-11D0-BC04-0080C7055A83">
<PARAM NAME="TextQualifier" VALUE="">
<PARAM NAME="FieldDelim" VALUE=",">
<PARAM NAME="DataURL" VALUE="data.csv">
<PARAM NAME="UseHeader" VALUE="true">
</OBJECT>
</HEAD>
<BODY>
<TABLE DATASRC="#dataTDC" BORDER="1" CELLSPACING="0">
<THEAD>
<TR>
<TD><B>Firm</B></TD>
<TD><B>Code</B></TD>
<TD><B>Server</B></TD>
</TR>
</THEAD>
<TR>
<TD><SPAN DATAFLD="Firm"></SPAN></TD>
<TD><SPAN DATAFLD="Code"></SPAN></TD>
<TD><SPAN DATAFLD="Server"></SPAN></TD>
</TR>
</TABLE>
</BODY>
</HTML>
Output result:
anyone could help me understand the following asp.net 2.0 coding?
It is supposed to show me a couple of the latest photos i uploaded to a particular folder in the photoalbum.
however when i upload a new file in an folder which already has images... the images that show up when using the code is the first images in this folder...
and sometimes nothing shows up...
<%
latestfolder = "na"
latestdate = cdate("01/01/09")
set fs=Server.CreateObject("Scripting.FileSystemObject")
set fo=fs.GetFolder(Server.MapPath("images/gallery"))
for each folder in fo.subfolders
if cdate(folder.DateLastModified) > latestdate then
latestdate = cdate(folder.DateLastModified)
latestfolder = folder.name
end if
next
if latestfolder <> "na" then
set fi=fs.GetFolder(Server.MapPath("images/gallery/" & latestfolder))
looptimes = 0
for each file in fi.files
if month(file.DateLastModified) = month(latestdate) then
if right(lcase(file.Name),3) = "jpg" then %>
<a href="thumbnail.aspx?picture=<%=server.URLEncode("images/gallery/" & latestfolder & "/" & file.Name)%>&maxWidth=640&maxHeight=480" target="_blank" style="text-decoration:none; cursor:pointer;">
<img src="thumbnail.aspx?picture=<%=server.URLEncode("images/gallery/" & latestfolder & "/" & file.Name)%>&maxWidth=100&maxHeight=60" style="border:1px solid #ffffff; margin:5px; margin-top:14px;">
</a>
<% end if
end if
looptimes = looptimes + 1
if looptimes = 6 then exit for end if
next
end if
%>
hope some can help me :)
Looks like the following code is picking up all JPEG files for the current month:
if month(file.DateLastModified) = month(latestdate) then
if right(lcase(file.Name),3) = "jpg" then%>
...
<% end if
end if
when it loops through the files, it checks whether the last modified date of the image matches the last modified date of the folder. that is the original coders definition of "a couple of the latest photos" for that album. it also makes sure that there's never more than 6.
If you don't upload photos all too often, you could easily end up with just one photo every time. If you don't get any photos out of it at all, you've probably done something else in that folder, that would've changed its last modified date, without adding any photos.
I'd consider getting rid of the month criteria, and just stick with the 6 photos limit, i.e. replace
if month(file.DateLastModified) = month(latestdate) then
if right(lcase(file.Name),3) = "jpg" then %>
<a href="thumbnail.aspx?picture=<%=server.URLEncode("images/gallery/" & latestfolder & "/" & file.Name)%>&maxWidth=640&maxHeight=480" target="_blank" style="text-decoration:none; cursor:pointer;">
<img src="thumbnail.aspx?picture=<%=server.URLEncode("images/gallery/" & latestfolder & "/" & file.Name)%>&maxWidth=100&maxHeight=60" style="border:1px solid #ffffff; margin:5px; margin-top:14px;">
</a>
<% end if
end if
with
if right(lcase(file.Name),3) = "jpg" then %>
<a href="thumbnail.aspx?picture=<%=server.URLEncode("images/gallery/" & latestfolder & "/" & file.Name)%>&maxWidth=640&maxHeight=480" target="_blank" style="text-decoration:none; cursor:pointer;">
<img src="thumbnail.aspx?picture=<%=server.URLEncode("images/gallery/" & latestfolder & "/" & file.Name)%>&maxWidth=100&maxHeight=60" style="border:1px solid #ffffff; margin:5px; margin-top:14px;">
</a>
<% end if