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:
Related
I'm using Classic ASP to add a note function to the table that is displaying rows from a database. The inserted row will save to the database saved Remarks but the following code isn't working.
<%
Dim fRemark
fRemark = Request.Form("Remarks")
Dim rsIntra,MyQryItr2
set cnIntra = Server.CreateObject("ADODB.Connection")
set MyQryItra2 = server.CreateObject ("ADODB.Recordset")
set rsIntra = Server.CreateObject("ADODB.Recordset")
MyQryItra2 = "select Remarks from [PurchaseOrderTrackInfo]"
rsIntra.Open MyQryItra,strRMSIDMcn
if rsIntra.eof then
MyQryItr2 = "insert into [PurchaseOrderTrackInfo] Remarks values N'" & fRemark & " '; "
cast(Remarks as int)
cnIntra.Execute MyQryItr2
else
rsIntra.close
set rsIntra = Nothing
set rsIntra = server.CreateObject("ADODB.Recordset")
MyQryItr2 = "UPDATE [PurchaseOrderTrackInfo] SET Remarks = N'" & fRemark & " '; where Remarks = rowID;"
end if
set rsIntra=Nothing
strConnDB= "Driver={SQL Server};Server=GB;Database=PurchaseOrderTrackInfo;UID=madfox;PWD=;"
%>
<td colspan="10" bordercolor=#3399ff bgcolor=#FFFF99 align="center">
<font face="Arabic Transparent" size="1" color="#800080"></font>
<form action=UpdatePO1.asp method=post >
<textarea name="Remarks" cols="20" rows="2" ><%=fRemark%></textarea>
<input type="submit" class="btn1" value="save" name="finish"/>
<input type="hidden" name="rowID" value="ID" />
</td>
</form>
<%
you never execute your update query. also your update statement does not seem to be valid as you are using the column Remarks as storage for the Remark and as row id. consider adding a rowid column to you table and use the following update statement
MyQryItr2 = "UPDATE [PurchaseOrderTrackInfo] SET Remarks = N'" & fRemark & " ' where rowId =" & rowID
cnIntra.Execute MyQryItr2
Since your code is vulnerabe to SQL injection, you should look up parameterized queries.
For example i have language switcher in index.asp
<ul class="drop-lang_menu">
<li id="LanguageSelected"><img src="img/icons/flags/ru.png" />Rus
<ul>
<li><img src="img/icons/flags/ru.png" />Rus</li>
<li><img src="img/icons/flags/lt.png" />Lit</li>
<li><img src="img/icons/flags/us.png" />Eng</li>
</ul>
</li>
</ul>
and also in this file i have translate function for "Login" button text translate
<%=transl("Login")%>
This function is explained in file function.inc which included in index.asp
<%
Dim Lang
Lang = Document.getElementById("LanguageSelected").innerText
Function transl(TxT as String)
Dim d
d = Application("TranslateList")
If d = "" Then
d = FetchTranslateList(TxT)
Application("TranslateList") = d
End If
transl = d
End Function
Function FetchTranslateList(TxT as String)
Dim rs, fldName, s
Set rs = CreateObject("ADODB.Recordset")
rs.Open "select "+Lang+" from Translations where txt='"+TxT+"'", _
"dsn=name;uid=sa;pwd=;"
s = "<select name=""Translations"">" & vbCrLf
Set fldName = rs.Fields("+Lang+")
Do Until rs.EOF
s = s & " <option>" & fldName _
& "</option>" & vbCrLf
rs.MoveNext
Loop
s = s & "</select>" & vbCrLf
rs.Close
Set rs = Nothing
Set fldName = Nothing
FetchTranslateList = s
End Function
%>
Questions is:
Lang = Document.getElementById("LanguageSelected").innerText seem not working! So how to get selected language value and translate webpage for each user separately ?
Is that is right way to make webpage translation depending on language which user select on the site?
Use asp to change language (document.getElement... is javascript!):
Rus</li>
then, lang = request.querystring("lang")
Other approach is create text files (rus.asp, esp.asp,...) with variables (txt_title="Titulo", txt_button_yes="Si",...) and includes one file or another depending of language. Include files is fast than query to database.
Another thing: is not a good idea create includes with .inc beacuse the code might be visible. Use .asp instead.
Document.getElementById("LanguageSelected").innerText looks like client side Javascript. ASP is server side code, it's executed when the page is served, so you'll need to populate your variable Lang either with a querystring value or a form submission and retrieve it with something like Lang = request("Lang")
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.
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 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).