tracyms
asked on
Wrap VBScript in HTA
Hello Experts,
I have a vbscript that I'd like to wrap in an HTML Application (HTA). I have the code below where I started but rather than beating my head against wall and endless Google searches to get this done - I'm here!
The code is working but I want the input box to be an hta input box and not a vbscript input box, thus having the HTA as the front end for the script. So users should use the hta as a form to enter search criteria instead of the vbs popup input box.
The code below queries a database and passes values to a text file. I then retrieve those values from the text file for my application.
So, this file is called - myHTA.hta
This is my app config file:
I hope this is clear - thanks!
I have a vbscript that I'd like to wrap in an HTML Application (HTA). I have the code below where I started but rather than beating my head against wall and endless Google searches to get this done - I'm here!
The code is working but I want the input box to be an hta input box and not a vbscript input box, thus having the HTA as the front end for the script. So users should use the hta as a form to enter search criteria instead of the vbs popup input box.
The code below queries a database and passes values to a text file. I then retrieve those values from the text file for my application.
So, this file is called - myHTA.hta
<!DOCTYPE html>
<html>
<head>
<title>HTA Test</title>
<HTA:APPLICATION
ID="objTest"
APPLICATIONNAME="HTATest"
SCROLL="yes"
SINGLEINSTANCE="yes"
>
<script language="vbScript">
Const ForReading = 1
Const ForWriting = 2
Dim objFSO 'File System Object
Dim objTS 'Text Stream Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Get current logged in username for path
strFileName = "C:\Users\" & createobject("wscript.shell").expandenvironmentstrings("%username%") & "\Desktop\TextFile.txt"
' Check if file exists, if not create it
If Not objFSO.FileExists(strFileName) then
Set oTxtFile = objFSO.CreateTextFile("C:\Users\" & createobject("wscript.shell").expandenvironmentstrings("%username%") & "\Desktop\TextFile.txt")
oTxtFile.Close
End If
' Open file for reading
If objFSO.FileExists(strFileName) then
Set objTS = objFSO.OpenTextFile(strFileName, ForReading)
' create variable to hold default value
If objTS.AtEndOfStream Then
inContent = ""
Else
inContent = objTS.ReadLine
End If
' Add default value to input box
strKey = InputBox("Enter Person ID (7 digit) or SSN (xxx-xx-xxxx)","Search", inContent) <----- This should be hta input box/search box
objTS.Close()
End If
' If input box empty, make application fields empty
If strKey = "" then
'msgbox "No data entered or you clicked Cancel" <----this could be in the body of the hta instead of a popup/msgbox
' If ID entered, look up against database
Else
strConnection = "Provider=SQLOLEDB;Server=Server_Name;Database=Database_Name;User ID=User_Name;Password=Password"
strSQL = "SELECT * FROM [My_Table] where [ID] = '" & strKey & "' OR [SSN] = '" & strKey & "'"
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open strConnection
Set objRecordSet = CreateObject("ADODB.Recordset")
objRecordSet.Open strSQL, objConnection, adLockReadOnly
do while objRecordSet.EOF = false
' Declare variable for msgbox
yourOutput = objRecordSet("ID") & vbNewLine & objRecordSet("Full_Name") & vbNewLine & objRecordSet("SSN") <----this could be in the body of the hta instead of a popup/msgbox
' Declare variable for input box default value
getOutput = objRecordSet("ID")
getOutput2 = objRecordSet("Full_Name")
objRecordSet.MoveNext
loop
objRecordSet.Close
Set objRecordSet=Nothing
objConnection.Close
Set Connection=Nothing
' If database match found
' msgbox results
' add results to text file, ID will be used as default value in input box
if yourOutput <> "" then
msgbox yourOutput, vbsystemmodal
Set objTS = objFSO.OpenTextFile(strFileName, ForWriting)
objTS.WriteLine(getOutput)
objTS.WriteLine(getOutput2)
objTS.Close()
Else
msgbox "No records found.", vbsystemmodal <----this could be in the body of the hta instead of a popup/msgbox
End If
End If
</script>
</head>
<body>
</body>
</html>This is my app config file:
'Call myHTA.hta
'Wait until hta process completes
Set shell = CreateObject("WScript.Shell")
shell.CurrentDirectory = "C:\Users\Me_User\Desktop\"
shell.Run "myHTA.hta", , True
'Read/send text file to my app fields
Const ForReading = 1, ForWriting = 2
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile("C:\Users\" & createobject("wscript.shell").expandenvironmentstrings("%username%") & "\Desktop\TextFile.txt", ForReading)
'This is first line of text
for i = 0 to 1
If i = 0 then
Field2 = f.ReadLine
End If
'This is second line of text
If i = 1 then
Field1 = f.ReadLine
End If
next
f.CloseI hope this is clear - thanks!
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
First, thanks aikimark for the code. It's giving me an error - "Error: Object required: 'txtInput". I actually got it working after mainly looking at this site - http://eddiejackson.net/go
I then kept at it to add additional features I thought users would find useful.
I also removed the following from my app config file as it was crashing - I finally figured out it was crashing because each time users clicked the button (to run the code in the app config) more than once it ran the script again causing it to crash.
'Call myHTA.hta
'Wait until hta process completes
Set shell = CreateObject("WScript.Shel
shell.CurrentDirectory = "C:\Users\Me_User\Desktop\
shell.Run "myHTA.hta", , True
If Bill Prew is reading this - he can appreciate how happy I was to get this resolved! :-)
At any rate - I've posted the updated code. The hta is used as a standalone to look up database information, once found my app button is clicked to pull in the data from the text file.
App config file
I then kept at it to add additional features I thought users would find useful.
I also removed the following from my app config file as it was crashing - I finally figured out it was crashing because each time users clicked the button (to run the code in the app config) more than once it ran the script again causing it to crash.
'Call myHTA.hta
'Wait until hta process completes
Set shell = CreateObject("WScript.Shel
shell.CurrentDirectory = "C:\Users\Me_User\Desktop\
shell.Run "myHTA.hta", , True
If Bill Prew is reading this - he can appreciate how happy I was to get this resolved! :-)
At any rate - I've posted the updated code. The hta is used as a standalone to look up database information, once found my app button is clicked to pull in the data from the text file.
<html>
<head>
<title>Database Lookup</title>
<HTA:APPLICATION
APPLICATIONNAME="DB_Search"
BORDER="thin"
borderstyle="complex"
icon=http://www.iconarchive.com/download/i62658/ampeross/qetto-2/search.ico
SCROLL="no"
SINGLEINSTANCE="yes"
WINDOWSTATE="normal"
maximizebutton="no"
minimizebutton="no"
>
<script language="vbScript">
Sub Window_onLoad
intWidth = 450
intHeight = 300
Me.ResizeTo intWidth, intHeight
Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))
End Sub
Sub Default_Buttons
If Window.Event.KeyCode = 13 Then
btn_runscript.Click
End If
End Sub
Sub RunScript
Const ForReading = 1
Const ForWriting = 2
Dim objFSO 'File System Object
Dim objTS 'Text Stream Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Get current logged in username for path
strFileName = "C:\Users\" & createobject("wscript.shell").expandenvironmentstrings("%username%") & "\Desktop\TextFile.txt"
' Check if file exists, if not create it
If Not objFSO.FileExists(strFileName) then
Set oTxtFile = objFSO.CreateTextFile("C:\Users\" & createobject("wscript.shell").expandenvironmentstrings("%username%") & "\Desktop\TextFile.txt")
oTxtFile.Close
End If
' Open file for reading
If objFSO.FileExists(strFileName) then
Set objTS = objFSO.OpenTextFile(strFileName, ForReading)
' create variable to hold default value
' Not using default anymore but maybe still need to check if end of stream?
If objTS.AtEndOfStream Then
inContent = ""
Else
inContent = objTS.ReadLine
End If
objTS.Close()
End If
' If input box empty, message
If strKey.value = "" then
msgbox "No data entered"
strKey.Focus
Else
'Connect to database and run query
strConnection = "Provider=SQLOLEDB;Server=Server_Name;Database=Database_Name;User ID=User_Name;Password=Password"
strSQL = "SELECT * FROM [My_Table] where [ID] ='" & strKey.value & "' OR [SSN] = '" & strKey.value & "'"
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open strConnection
Set objRecordSet = CreateObject("ADODB.Recordset")
objRecordSet.Open strSQL, objConnection, adLockReadOnly
do while objRecordSet.EOF = false
' Declare variable for output to screen
strHTML = strHTML & objRecordSet("ID") & "<br>" & objRecordSet("Full_Name")
DataArea.InnerHTML = strHTML
' Declare variable for adding to text file
getOutput = objRecordSet("ID")
getOutput2 = objRecordSet("Full_Name")
objRecordSet.MoveNext
loop
objRecordSet.Close
Set objRecordSet=Nothing
objConnection.Close
Set Connection=Nothing
' If database match found
' send results to screen in red font
' add ID and Full Name to text file
if strHTML <> "" then
DataArea.InnerHTML = "<font color='red' face='Arial'>" & strHTML & "</font>"
Set objTS = objFSO.OpenTextFile(strFileName, ForWriting)
objTS.WriteLine(getOutput)
objTS.WriteLine(getOutput2)
objTS.Close()
Else
' If data entered not in database, message
msgbox "No records found.", vbsystemmodal
End If
End If
End Sub
' button to clear text box and screen contents
Sub ClearWindow
DataArea.InnerHTML = ""
strKey.value = ""
End Sub
' button to close HTA
Sub itClosed
DataArea.InnerHTML = ""
strKey.value = ""
window.close
End Sub
' Help button
Sub showHelp
MsgBox "Search:" &(Chr(13) & Chr(10))& "Enter search criteria, click Search button."&(Chr(13) & Chr(10))& (Chr(13) & Chr(10))& "Refresh:"&(Chr(13) & Chr(10))& _
"Click this button to clear contents from screen.",0,"HELP"
End Sub
</script>
</head>
<body style="background-color:#B0C4DE; font-family: arial" onkeypress='vbs:Default_Buttons'>
<table width='90%' height = '100%' align='center' border='0'>
<tr>
<td align='center'>
</td>
</tr>
<tr>
<td align='center'>
<h5>Enter Person ID (7 digit) or SSN (xxx-xx-xxxx)</h5><br>
<input type="text" size="40" id="strKey" name="strKey"> 
<input type="button" value="Search" name="btn_runscript" onClick="vbs:RunScript"><br><br>
</td>
</tr>
<tr>
<td align='center'>
<input id=runbutton type="button" value="Refresh" onClick="ClearWindow">     
</td>
</tr>
<tr>
<td align='center'>
<span id = "DataArea"></span>
</td>
</tr>
<tr>
<td align='left'>
<p></p>
<p></p>
<p></p>
<input type="button" value="Help" name="btn_help" onClick="showHelp">                                                                        
<input type="button" value="Exit" name="btn_exit" onClick="itClosed">
</td>
</tr>
</table>
</body>
</body>
</html>App config file
'Read/send text file to my app fields
Const ForReading = 1, ForWriting = 2
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile("C:\Users\" & createobject("wscript.shell").expandenvironmentstrings("%username%") & "\Desktop\TextFile.txt", ForReading)
'This is first line of text
for i = 0 to 1
If i = 0 then
Field2 = f.ReadLine
End If
'This is second line of text
If i = 1 then
Field1 = f.ReadLine
End If
next
f.Close
I am following, just didn't have time to work it yet, glad other experts are helping.
»bp
»bp
ASKER
Bill, it was just an fyi for you since we had worked on this code before and I mentioned the crashing thing. I actually think I'm fine with what I have. The only other thing I wish is I could hide the following part of the code for security purposes. I've heard you can use a program called vbedit to make an exe, not sure if that will secure it? Or can I place that part of the code on our server and call it in the script?
strConnection = "Provider=SQLOLEDB;Server=
strSQL = "SELECT * FROM [My_Table] where [ID] = '" & strKey & "' OR [SSN] = '" & strKey & "'"
The user/pass in the code has read only access to database and the hta will be for our internal company but I would like to add some security if possible. Any suggestions anyone?
strConnection = "Provider=SQLOLEDB;Server=
strSQL = "SELECT * FROM [My_Table] where [ID] = '" & strKey & "' OR [SSN] = '" & strKey & "'"
The user/pass in the code has read only access to database and the hta will be for our internal company but I would like to add some security if possible. Any suggestions anyone?
ASKER
I managed to find something that may work but the it only runs once. So when I first click the Search button the code runs but if I click it again nothing happens.
Here is where I got the idea - https://community.spicewor
This is how I'm calling it in my code:
Sub RunScript(sInstFile)
Dim f, s, oFSO
Set oFSO = CreateObject("Scripting.Fi
On Error Resume Next
If oFSO.FileExists(sInstFile)
Set f = oFSO.OpenTextFile(sInstFil
s = f.ReadAll
f.Close
ExecuteGlobal s
End If
On Error Goto 0
Set f = Nothing
Set oFSO = Nothing
End Sub
This is the button that should execute the code each time it's pushed but is only running once:
<input type="button" value="Search" name="btn_runscript" onClick=RunScript("\\Serve
Is there something I'm missing to allow it to execute the code anytime the button is clicked?
Here is where I got the idea - https://community.spicewor
This is how I'm calling it in my code:
Sub RunScript(sInstFile)
Dim f, s, oFSO
Set oFSO = CreateObject("Scripting.Fi
On Error Resume Next
If oFSO.FileExists(sInstFile)
Set f = oFSO.OpenTextFile(sInstFil
s = f.ReadAll
f.Close
ExecuteGlobal s
End If
On Error Goto 0
Set f = Nothing
Set oFSO = Nothing
End Sub
This is the button that should execute the code each time it's pushed but is only running once:
<input type="button" value="Search" name="btn_runscript" onClick=RunScript("\\Serve
Is there something I'm missing to allow it to execute the code anytime the button is clicked?
ASKER
Sorry, forgot - this is the contents of Test.txt on \\Server\Share\myTest.txt:
I basically took out a piece of code and put it in a text file and calling it with the button onclick.
Const ForReading = 1
Const ForWriting = 2
Dim objFSO 'File System Object
Dim objTS 'Text Stream Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Get current logged in username for path
strFileName = "C:\Users\" & createobject("wscript.shell").expandenvironmentstrings("%username%") & "\Desktop\TextFile.txt"
' Check if file exists, if not create it
If Not objFSO.FileExists(strFileName) then
Set oTxtFile = objFSO.CreateTextFile("C:\Users\" & createobject("wscript.shell").expandenvironmentstrings("%username%") & "\Desktop\TextFile.txt")
oTxtFile.Close
End If
' Open file for reading
If objFSO.FileExists(strFileName) then
Set objTS = objFSO.OpenTextFile(strFileName, ForReading)
' create variable to hold default value
' Not using default anymore but maybe still need to check if end of stream?
If objTS.AtEndOfStream Then
inContent = ""
Else
inContent = objTS.ReadLine
End If
objTS.Close()
End If
' If input box empty, message
If strKey.value = "" then
msgbox "No data entered"
strKey.Focus
Else
'Connect to database and run query
strConnection = "Provider=SQLOLEDB;Server=Server_Name;Database=Database_Name;User ID=User_Name;Password=Password"
strSQL = "SELECT * FROM [My_Table] where [ID] ='" & strKey.value & "' OR [SSN] = '" & strKey.value & "'"
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open strConnection
Set objRecordSet = CreateObject("ADODB.Recordset")
objRecordSet.Open strSQL, objConnection, adLockReadOnly
do while objRecordSet.EOF = false
' Declare variable for output to screen
strHTML = strHTML & objRecordSet("ID") & "<br>" & objRecordSet("Full_Name")
DataArea.InnerHTML = strHTML
' Declare variable for adding to text file
getOutput = objRecordSet("ID")
getOutput2 = objRecordSet("Full_Name")
objRecordSet.MoveNext
loop
objRecordSet.Close
Set objRecordSet=Nothing
objConnection.Close
Set Connection=Nothing
' If database match found
' send results to screen in red font
' add ID and Full Name to text file
if strHTML <> "" then
DataArea.InnerHTML = "<font color='red' face='Arial'>" & strHTML & "</font>"
Set objTS = objFSO.OpenTextFile(strFileName, ForWriting)
objTS.WriteLine(getOutput)
objTS.WriteLine(getOutput2)
objTS.Close()
Else
' If data entered not in database, message
msgbox "No records found.", vbsystemmodal
End If
End IfI basically took out a piece of code and put it in a text file and calling it with the button onclick.
I don't see any obvious problem with that. I think you might have to sprinkle some msgbox statements along the way to see where it goes and if all the code is executing, etc. Also make sure you don't have any ON ERROR RESUME NEXT statements that would hide error messages.
»bp
»bp
Can you give your users who run the hta access to the sql table using their domain account rather than specifying an account in the vbscript.dll, it wouldn't take 30 secs for someone interested enough to look at the hta and see it runs a script which then has a password anyway.
Steve
Steve
ASKER
Thanks Steve, that's an option I've considered. I was given the single user/password with read only access to use for this purpose.
This HTA/executable is for internal users who need to be on the network to access. Making it an executable won't show the credentials. Of course if someone wanted access (which applies to any exe) they can do the extra work/get access to tools to do so. I don't see this as an immediate threat as users cannot install software on their own.
I actually used HTAEdit - http://htaedit.com/ to make the HTA an executable.
The only other thing is the executable places the HTA in user's \AppData\Local\Temp\{folde
For /R "C:\Users\%username%\AppDa
pause
While the above command runs from the command line, I can't get it into a vbscript below. I get a expected end of statement error. Of course I'll remove the "pause" once I confirm it works.
Dim oShell
Set oShell = WScript.CreateObject ("WScript.Shell")
oShell.run cmd For /R ""C:\Users\%username%\AppD
Set oShell = Nothing
Bill, I can't figure out why its not working with the calling thing. I have no on error resume next and I've added a popup/msgbox which also works but again only one time.
Thanks!
This HTA/executable is for internal users who need to be on the network to access. Making it an executable won't show the credentials. Of course if someone wanted access (which applies to any exe) they can do the extra work/get access to tools to do so. I don't see this as an immediate threat as users cannot install software on their own.
I actually used HTAEdit - http://htaedit.com/ to make the HTA an executable.
The only other thing is the executable places the HTA in user's \AppData\Local\Temp\{folde
For /R "C:\Users\%username%\AppDa
pause
While the above command runs from the command line, I can't get it into a vbscript below. I get a expected end of statement error. Of course I'll remove the "pause" once I confirm it works.
Dim oShell
Set oShell = WScript.CreateObject ("WScript.Shell")
oShell.run cmd For /R ""C:\Users\%username%\AppD
Set oShell = Nothing
Bill, I can't figure out why its not working with the calling thing. I have no on error resume next and I've added a popup/msgbox which also works but again only one time.
Thanks!
Looks like you are missing a leading double quote, try:
»bp
oShell.run "cmd For /R ""C:\Users\%username%\AppData\Local\Temp\"" %%G IN (*.hta) do del ""%%G"" & pause" »bp
On the looping issue, unfortunately with the database etc its pretty hard for me to try it here ans try to reproduce...
»bp
»bp
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thanks Steve - the shorter the better! I'm getting a type mismatch error '[string:"%TEMP%\*.hta"]" when running vbs code below but runs fine from command prompt:
Dim oShell
Set oShell = WScript.CreateObject ("WScript.Shell")
DEL "%TEMP%\*.hta" /s
oShell.run "cmd DEL ""%TEMP%\*.hta"" & /s & pause"
Set oShell = Nothing
Bill, yours runs but says file not found - the file is there.
Dim oShell
Set oShell = WScript.CreateObject ("WScript.Shell")
DEL "%TEMP%\*.hta" /s
oShell.run "cmd DEL ""%TEMP%\*.hta"" & /s & pause"
Set oShell = Nothing
Bill, yours runs but says file not found - the file is there.
You can't run this line from the VBS HTA, remove it, leave the Run() of it that you have.
DEL "%TEMP%\*.hta" /s
»bp
DEL "%TEMP%\*.hta" /s
»bp
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thanks Bill!
I add this to my exit button sub (note I took out the "WScript" from WScript.CreateObject ("WScript.Shell") to make it CreateObject("WScript.Shel
I add this to my exit button sub (note I took out the "WScript" from WScript.CreateObject ("WScript.Shell") to make it CreateObject("WScript.Shel
' button to close HTA
Sub itClosed
DataArea.InnerHTML = ""
strKey.value = ""
Dim oShell
Set oShell = CreateObject("WScript.Shell")
oShell.Run "CMD /C DEL ""%TEMP%\*.hta"" /S & PAUSE"
Set oShell = Nothing
window.close
End SubASKER
oops - took out the pause part of course:
' button to close HTA
Sub itClosed
DataArea.InnerHTML = ""
strKey.value = ""
Dim oShell
Set oShell = CreateObject("WScript.Shell")
oShell.Run "CMD /C DEL ""%TEMP%\*.hta"" /S"
Set oShell = Nothing
window.close
End SubASKER
Thanks to everyone!
Open in new window