Doing an Access Query with PS Script over VB and writing output in HTA Textbox - powershell

I am new to PowerShell and got the following Task.
I have to Create a HTA GUI where you can write the Name to search for in the Access Query.
The VB Script in the HTA File starts the PS Script and passes the Parameter of the user Input in the HTA TextBox. After that the PowerShell Script does a Access Query with the user Input to get some results. These results should somehow get back to the VB/HTA File so it can Output every single result in an other TextBox.
Is this even possible to do? If yes, i would appreciate some solution ideas.
EDIT:
VB/HTA
VB/HTA
Wrong Format, should be like a table

You have strLine in the HTA code that reads the text file. Your code is reading the text file and taking 1 line and putting it in a text input box. In order to show the results as a table you need to create the table HTML and pass that HTML to a div element.
strLine = "<table>"
Do While Not strLines.AtEndOfStream
strLine = strLine & "<tr><td>" & strLines.ReadLine() & "</td></tr>"
Loop
strLine = strLine & "</table>"
Weiterleitung_div.innerHTML = strLine
You will need to change Weiterleitung_id.value = strLine and instead pass the strLine HTML to a element in the body. Add to the body and then

Yes it is possible. Try the code below with an access database that has 3 fields first_name, last_name, email
Save the file as Employees.mdb (you can use .accdb but you'll have to change the name in code) MAKE SURE THE ACCESS FILE IS IN THE SAME FOLDER AS THE HTA.
I copied in some data from www.mockaroo.com to test it out (I don't get paid to say that it's just very useful)
This is a very basic example but it is possible to create a nicer GUI in an HTA than in Access.
<title>Employee Directory</title>
<head>
<HTA:APPLICATION
ID="EMPDIR"
APPLICATIONNAME="Employee Directory"
SINGLEINSTANCE="YES"
>
<!-- makes the hta run using IE9 otherwise it runs as IE5 or 6. You can change this to edge -->
<meta http-equiv="x-ua-compatible" content="IE=9"/>
<style>
body {font-family:arial; background:#efefef; color:#333}
</style>
<script language="vbscript">
' ///// this creates the connection when the file is first run.
' //// get the current path if the database file is in the same folder as the hta file. if it's not then enter the full path manually below
Set objFSO = CreateObject("Scripting.FileSystemObject")
curDir = objFSO.GetAbsolutePathName(".") & "\"
Dim oCon: Set oCon = CreateObject("ADODB.Connection")
Dim oRs: Set oRs = CreateObject("ADODB.Recordset")
strCon = "Driver={Microsoft Access Driver (*.mdb, *.accdb)};Dbq="& curDir & "Employees.mdb;"
oCon.ConnectionString= strCon
sub getEmployeeList
' gets a list of employees based on the value in the searchbox input.
oCon.open
strSQL = "SELECT * FROM Employees WHERE (first_name like '%" & searchbox.value & "%') or (last_name like '%" & searchbox.value & "%')"
Set oRs = oCon.Execute(strSQL)
strHTML = "<table>"
do while not oRs.EOF
strHTML = strHTML & "<tr><td>" & oRs.fields("first_name") & "</td><td>" & oRs.fields("last_name") & "</td><td>" & oRs.fields("email") & "</td></tr>"
oRs.movenext
loop
oCon.close
strHTML = strHTML & "</table>"
divEmployeeList.innerHTML = strHTML
end Sub
</script>
</head>
<body>
<div id="search"><input type="text" id="searchbox" style="font-size:16pt; margin:10px;"/> <input type="button" value="search" name="submitsearch" style="font-size:16pt;" onclick="getEmployeeList" language="vbscript"></div>
<div id="divEmployeeList" style="width:90%; height:300px; overflow-y:scroll; border:solid 1px #666; margin:10px; background:#fff">-</div>
</body>

Related

LibreOffice Calc macro to save a named sheet in a csv file

There is a Calc file named as 'Data.ods' with a sheet named 'DataSheet' which should be saved in a 'Data.csv' file in the current directory using {tab} as field delimiter and double quoted data fields. How to implement this in LO Basic macro?
You have not specified whether the macro should open the 'Data.ods' spreadsheet or whether it is already open. This code works with the current spreadsheet:
Sub Generate_CSV()
Dim sURL As String ' URL of current spreadsheet
Dim FileN As String ' URL of target CSV-file
Dim oCurrentController As Object ' Before save - activate sheet sSheetName
Dim storeParms(2) as new com.sun.star.beans.PropertyValue
Const sSheetName = "DataSheet"
GlobalScope.BasicLibraries.LoadLibrary("Tools") ' Only for GetFileName
sURL = thisComponent.getURL()
If Not thisComponent.getSheets().hasByName(sSheetName) Then
MsgBox ("Sheet """ & sSheetName & """ Not Found In Current Spreadsheet")
Exit Sub
EndIf
FileN = GetFileNameWithoutExtension(sURL) & ".csv" ' For Data.ods it will be Data.csv
REM Options to StoreTo:
storeParms(0).Name = "FilterName"
storeParms(0).Value = "Text - txt - csv (StarCalc)"
storeParms(1).Name = "FilterOptions"
storeParms(1).Value = "9,34,,65535,1,,0,true,true,true"
REM About this string see https://wiki.openoffice.org/wiki/Documentation/DevGuide/Spreadsheets/Filter_Options
storeParms(2).Name = "Overwrite"
storeParms(2).Value = True
REM Activate sheet for export - select "DataSheet"
thisComponent.getCurrentController().setActiveSheet(thisComponent.getSheets().getByName(sSheetName))
REM storeToURL can raises com.sun.star.io.IOException! Only now:
On Error GoTo Errorhandle
REM Export
thisComponent.storeToURL(FileN,storeParms())
MsgBox ("No Error Found,Upload file is saved : """ + ConvertFromUrl(FileN) + """.")
Exit Sub
Errorhandle:
MsgBox ("Modifications Are Not Saved,Upload File Not Generated" & chr(13) _
& "May be table " & ConvertFromUrl(FileN) & " is open in another window?")
Exit Sub
Resume
End Sub
(It was posted on 18 Nov 2011 there)

Use VBScript in HTML to write a PowerShell script

I'm trying to use VBScript in HTML to write text into what will become a powershell script. I am doing this to avoid having to statically code into my HTA the location of these powershell scripts.
My problem becomes working around Powershell's " ( and )
An example, I'm just not sure how to wrap the characters in order to keep VBS happy.
Dim filesys, filetxt
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Set filesys = CreateObject("Scripting.FileSystemObject")
Set filetxt = filesys.OpenTextFile("c:\Temp\somefile.txt", ForAppending, True)
filetxt.WriteLine ("Param([Parameter(Mandatory=$true)]")
filetxt.WriteLine ("[string]$Str)")
filetxt.WriteLine ("# Create the IE com object")
filetxt.WriteLine ("$ie = new-object -comobject InternetExplorer.Application")
filetxt.WriteLine ("#Navigate to www.")
filetxt.WriteLine ("$ie.navigate("http://www.page.com")")
Assuming that last line is your only issue, you can escape the quotes either by doubling them up or by using Chr(34) to programatically insert them.
filetxt.WriteLine ("$ie.navigate(""http://www.page.com"")")
filetxt.WriteLine ("$ie.navigate(" & Chr(34) & "http://www.page.com" & Chr(34) & ")")

Request.QueryString And Request.ServerVariables("QUERY_STRING") Not Displaying UNICODE

I'm adding logging functionality to a Classic ASP application and am having difficulty getting Request.QueryString and Request.ServerVariables to display correctly when users submit UNICODE queries.
For example -
Response.write Request.QueryString
strVar1=&strVar2=%E8%A1%8C%E9%9B%B2%E6%B5%81%E6%B0%B4&strVar3=blah1&strVar4=blah2
Response.write Request.ServerVariables("QUERY_STRING")
strVar1=&strVar2=%E8%A1%8C%E9%9B%B2%E6%B5%81%E6%B0%B4&strVar3=blah1&strVar4=blah2
Yet if I specify a UNICODE variable in Request.QueryString it prints correctly:
Response.write Request.QueryString("strVar2")
行雲流水
How can I get Request.QueryString or Request.ServerVariables("QUERY_STRING") to include UNICODE? I do have the following on both my search and results pages and queries execute successfully against the database:
<%
Response.CodePage = 65001
Response.CharSet = "utf-8"
%>
To answer bobince's question, I'm trying to log search terms and pages from which they're submitted - if there's a better way to do this I'm all ears:
'Enable Logging: writes to MyDB.dbo.logging
'---------------------------------------------------------------------------------------------
Set cmd = Server.CreateObject("ADODB.Command")
cmd.CommandType = adCmdText
cmd.ActiveConnection = objConn
strADName = UCase(Request.ServerVariables("AUTH_USER"))
Protocol = Request.ServerVariables("SERVER_PROTOCOL")
Protocol = Left(Protocol,InStr(Request.ServerVariables("SERVER_PROTOCOL"),"/")-1)
if Request.ServerVariables("SERVER_PORT") = "80" then
port = ""
else
port = ":" & Request.ServerVariables("SERVER_PORT")
end if
CurPageURL = lcase(Protocol) & "://" & Request.ServerVariables("SERVER_NAME") &_
port & Request.ServerVariables("SCRIPT_NAME") & "?" & _
Request.ServerVariables("QUERY_STRING")
strSQL = "INSERT INTO MyDB.dbo.Logging([user],URL) SELECT ?, ? "
cmd.Parameters.Append (cmd.CreateParameter("User", adVarWChar, adParamInput, len(strADName), strADName))
cmd.Parameters.Append (cmd.CreateParameter("URL", adVarWChar, adParamInput, len(CurPageURL), CurPageURL))
cmd.CommandText = strSQL
set objRS = cmd.Execute
'-----------------------------------------------------------------------------------------------
This isn't really anything to do with Unicode.
Request.QueryString does two separate things.
If you use it without arguments, it returns the whole query string exactly as submitted by the browser (as above, the same as the QUERY_STRING server variable).
If you use it with an argument like "strVar2", it splits up the query string into parameter parts, finds the one(s) that correspond to the argument name (strVar2=...), and returns the value. In doing so it takes care of URL-decoding the components of the query string including the name and the value, so the %xx sequences in the input are decoded to the byte sequence they represent: 0xE8, 0xA1, 0x8C and so on. When you print that byte string to a page that a browser decodes as UTF-8, they will see 行雲流水.
You can do a URL-decode step yourself on the full query string if you really want. There isn't a built-in for URL-decoding in Classic ASP but you can write such a function yourself (see eg URLDecode from http://www.aspnut.com/reference/encoding.asp), or use
decodeURIComponent(s.replace(/\+/g, ' '))
from JScript.
Note that if you URL-decode a whole URL string together you are kind of breaking it. For example for input query string:
foo=abc%26def&bar=%e6%97%a5%e6%9c%ac%e8%aa%9e
you would get:
foo=abc&def&bar=日本語
which is fine for the Japanese, but the ampersand in the value for foo has broken the whole string so you can no longer tell for sure what the original parameters were. You should generally only decode URL components once you have split them up from the URL they came in. This is what ASP does for you: Request.QueryString("foo") would correctly return abc&def here which is why you should almost always be using that method to retrieve parameters.
What exactly are you trying to do by decoding a whole query string?
In case this can help someone else:
I resolved this by extracting variable names from QUERY_STRING using the split function with & as the delimiter. I then used the variables with Request.QueryString to get the values, including ones with UNICODE. This works unless the user includes & in the query, which will be pretty rare. I do trap for it so at least in that case I can still see the user and page accessed in the logs. Bobince your response was excellent and I will select it as the answer.
'Enable Logging: writes to MyDB.dbo.logging
'---------------------------------------------------------------------------------------------
Set cmd = Server.CreateObject("ADODB.Command")
cmd.CommandType = adCmdText
cmd.ActiveConnection = objConn
cmd.CommandTimeOut = 1200
strADName = UCase(Request.ServerVariables("AUTH_USER"))
Protocol = Request.ServerVariables("SERVER_PROTOCOL")
Protocol = Left(Protocol,InStr(Request.ServerVariables("SERVER_PROTOCOL"),"/")-1)
if Request.ServerVariables("SERVER_PORT") = "80" then
port = ""
else
port = ":" & Request.ServerVariables("SERVER_PORT")
end if
CurPageURL = lcase(Protocol) & "://" & Request.ServerVariables("SERVER_NAME") &_
port & Request.ServerVariables("SCRIPT_NAME") & "?"
On Error Resume Next
a = Request.ServerVariables("QUERY_STRING")
a = split(a,"&")
for each x in a
'response.write(left(x,InStr(x,"=")-1) & "<br />")
CurPageURL = CurPageURL + left(x,InStr(x,"=")-1) + "=" + Request.QueryString(left(x,InStr(x,"=")-1)) & "&"
next
If Err.Number <> 0 Then
CurPageURL = CurPageURL + "Error: Search Term Contained a &"
Err.Clear
Else
CurPageURL = left(CurPageURL,len(CurPageURL)-1)
End If
strSQL = "INSERT INTO MyDB.dbo.Logging([user],URL) SELECT ?, ? "
cmd.Parameters.Append (cmd.CreateParameter("User", adVarWChar, adParamInput, len(strADName), strADName))
cmd.Parameters.Append (cmd.CreateParameter("URL", adVarWChar, adParamInput, len(CurPageURL), CurPageURL))
cmd.CommandText = strSQL
set objRS = cmd.Execute

Excel will not close processes

So, I'm using (after modification) this code, from here: How to set recurring schedule for xlsm file using Windows Task Scheduler
My error: Runtime error: Unknown runtime error.
I've searched far and wide to find an way to close the Excel process, but almost everybody uses .Quit sadly it gives the above error. I've also tried .Close, but that is not recognized
' Create a WshShell to get the current directory
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
' Create an Excel instance
Dim myExcelWorker
Set myExcelWorker = CreateObject("Excel.Application")
' Disable Excel UI elements
myExcelWorker.DisplayAlerts = False
myExcelWorker.AskToUpdateLinks = False
myExcelWorker.AlertBeforeOverwriting = False
myExcelWorker.FeatureInstall = msoFeatureInstallNone
' Tell Excel what the current working directory is
Dim strSaveDefaultPath
Dim strPath
strSaveDefaultPath = myExcelWorker.DefaultFilePath
strPath = "C:\Users\hviid00m\Desktop"
myExcelWorker.DefaultFilePath = strPath
' Open the Workbook specified on the command-line
Dim oWorkBook
Dim strWorkerWB
strWorkerWB = strPath & "\Status Report (Boxplots) TEST.xlsm"
Set oWorkBook = myExcelWorker.Workbooks.Open (strWorkerWB, , , , , , True)
' Build the macro name with the full path to the workbook
Dim strMacroName
strMacroName = "Refresh"
on error resume next
myExcelWorker.Run strMacroName
if err.number <> 0 Then
WScript.Echo "Fejl i macro"
End If
err.clear
on error goto 0
oWorkBook.Save
' Clean up and shut down
' Don’t Quit() Excel if there are other Excel instances
' running, Quit() will shut those down also
myExcelWorker.Quit <--- ERROR
Set oWorkBook = Nothing
Set myExcelWorker = Nothing
Set WshShell = Nothing
Found some code on a different side.
The reason why (as far as I understood) is that .Quit and .Close is for VBA not VBS.
' Clean up and shut down
' Don’t Quit() Excel if there are other Excel instances
' running, Quit() will shut those down also
Dim objWMIService, objProcess, colProcess
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colProcess = objWMIService.ExecQuery ("Select * from Win32_Process Where Name = " & "'EXCEL.EXE'")
For Each objProcess in colProcess
objProcess.Terminate()
Next`
Set oWorkBook = Nothing
Set myExcelWorker = Nothing
Set WshShell = Nothing

why is this vbscript not fetching any value?

i am trying to write a vbscript that extracts the value from src attribute of an <img> tag that has a class attribute as this cs-poster-big
here is the code i have tried so far,
'Initializing object with Internet Explorer Application
set IE = WScript.CreateObject("InternetExplorer.Application", "IE_")
'setting properties of Internet Explorer to the newly create object
with IE
.Visible = 0
.navigate "http://www.roku.com/channels/#!details/12" 'INSERT WEBPAGE HERE
end with
'waiting for IE to load the page
'tried using IE.busy or IE.readyState <> 4 also
while IE.busy
wScript.sleep 500
wend
wScript.sleep 500
'getting all image tags from the webpage
Set imgTags = IE.document.getElementsByTagName("IMG")
'iterating through the image tags to find the one with the class name specified
For Each imgTag In imgTags
'tried imgTag.className also
If imgTag.getAttribute("class") = "cs-poster-big" Then MsgBox "src is " & imgTag.src
next
IE.quit
set IE= Nothing
MsgBox "End of script"
and it is not displaying any value but you can view the source of the page here and you can see it has an <img> tag with class cs-poster-big
i don't understand why it is not displaying in my script
Do While IE.Busy Or IE.ReadyState <> 4
WScript.Sleep 500
Loop
Wait until page is completely loaded.
EDIT - While this works in IE10, IE8 fails to locate the image. Not tested in other versions.
In this case, try to change your url to
http://www.roku.com/channels?_escaped_fragment_=details/12/netflix#!details/12/netflix
to avoid problems with the dynamic generate content.
Also, in IE8, code needs to be changed to get class name of the image. It should be
Do While IE.Busy Or IE.ReadyState <> 4
WScript.Sleep 100
Loop
Set imgTags = IE.document.getElementsByTagName("IMG")
For Each imgTag In imgTags
imgClass = imgtag.getAttribute("class")
If IsNull( imgClass ) Then
imgClass = imgTag.className
End If
If imgclass = "cs-poster-big" Then
MsgBox "src is " & imgTag.src
End If
Next
But not a solution, just a workaround.