Inno Setup Creating a shortcut to a HTA with administrative rights - inno-setup

I'm using Inno Setup to create a desktop shortcut that opens an HTA file saved in Program Files on Windows 7. This HTA file calls an external exe file that needs to run as administrator.
So, to do this, I want to automatically create a shortcut that runs as admin using Inno Setup. The problem here is that the shortcut points to an HTA file instead of an exe. How do I go about doing that?

check this sample:
<html>
<head>
<title>HTA Helpomatic</title>
<HTA:APPLICATION
ID="oHTA"
APPLICATIONNAME="HTAHelpomatic"
SCROLL="yes"
SINGLEINSTANCE="yes"
>
<!-- ID="objHTAHelpomatic" -->
<!-- WINDOWSTATE="maximize" -->
</head>
<SCRIPT Language="VBScript">
If HTAElevate() = True Then
CreateObject("WScript.Shell").Run "mmc.exe compmgmt.msc", , True
Call Main()
End If
Sub Main()
MsgBox "HTA-Ende", 4096
End Sub
'*** v13.3 *** www.dieseyer.de *****************************
Function HTAElevate()
'***********************************************************
' http://dieseyer.de/scr/elevate.hta
' Unter Windows x64 laufen VBS' nach einem Doppelklick in der x64-Umgebung
' mit %WinDi%\System32\wscript.exe oder mit %WinDi%\System32\cscript.exe.
' In der x64-Umgebung laufen VBS aber nicht (richtig). Die Prozedur
' HTAElevate() erkennt dies und startet ggf. das VBS in der
Const Elev = " /elevated"
' MsgBox oHTA.commandLine, , "5016 :: "
' Trace32Log "5018 :: oHTA.commandLine: ==" & oHTA.commandLine & "==", 1
HTAElevate = True
' If InStr( LCase( oHTA.commandLine ), Elev) > 0 then MsgBox oHTA.commandLine, , "5022 :: "
If InStr( LCase( oHTA.commandLine ), Elev) > 0 then Exit Function
On Error Resume Next
window.resizeto 750, 10 ' : window.moveto screen.width / 2, screen.height / 2
On Error GoTo 0
' MsgBox oHTA.commandLine, , "5030 :: "
createobject("Shell.Application").ShellExecute "mshta.exe", oHTA.commandLine & Elev, "", "runas", 1
HTAElevate = False
self.close
End Function ' HTAElevate()
</SCRIPT>
<body>
</body>
</html>

The direct answer to the question is to create the shortcut to mshta.exe with the HTA's filename as its parameter. The shortcut to mshta.exe can be marked to run as administrator.

If your executable requires admin access, then you should add an appropriate manifest to your executable, not try and elevate the HTML application.

Related

Excel: Return / Wordwrap / Second or more lines in firstpage.footer?

i'd like to Change my footers via VBA.
Companyname
Path and Filename
i can change the standardfooter by
ActiveSheet.PageSetup.LeftFooter = "&7My Company" & Chr(10) & "&Z&F"
but i cant change the FirstPage.Footer to get a wordwrap
My Code is ActiveSheet.PageSetup.FirstPage.LeftFooter.Text "&7My Company" & Chr(10) & "&Z&F"
but i only get 'My Comany' and no second line.
Any suggestions?
Hallo zusammen,
wie bekomme ich einen Zeilenumbruch in die Fußzeile der ersten Seite?
Viele Grüße

Adding internal Search function to Screnegraph Brightscript Channell

I need to add search functionality to my Brightscript scenegraph script for a Roku Channel. Does anyone have a simple Search sample, or a script I can use to add to a "sliding panel" Roku channel script?
RoSearch has been depreciated.
The current page is very similar to the Sliding Panel example.
Need working Search feature on my Roku Channel.
<component name = "minikeyboardexample" extends = "Group" initialFocus = "exampleMiniKeyboard" >
<script type="text/brightscript" >
<![CDATA[
sub init()
m.testlabel = m.top.FindNode("testLabel")
m.testpostergrid = m.top.FindNode("testPosterGrid")
m.testpostergridcontent = createObject("roSGNode","ContentNode")
m.readPosterGridTask = createObject("roSGNode","postergridCR")
m.readPosterGridTask.setField("postergriduri","http://test-xml.xml")
m.readPosterGridTask.observeField("gotitem","buildpostergrid")
m.readPosterGridTask.observeField("gotcontent","showpostergrid")
m.readPosterGridTask.control = "RUN"
m.top.setFocus(true)
end sub
sub buildpostergrid()
gridposter = createObject("roSGNode","ContentNode")
gridposter.hdgridposterurl = m.readPosterGridTask.hdgridposterurl
gridposter.hdposterurl = m.readPosterGridTask.hdposterurl
gridposter.sdgridposterurl = m.readPosterGridTask.sdgridposterurl
gridposter.sdposterurl = m.readPosterGridTask.sdposterurl
gridposter.shortdescriptionline1 = m.readPosterGridTask.shortdescriptionline1
gridposter.shortdescriptionline2 = m.readPosterGridTask.shortdescriptionline2
gridposter.x = m.readPosterGridTask.xposterpos
gridposter.y = m.readPosterGridTask.yposterpos
gridposter.w = m.readPosterGridTask.wnumcols
gridposter.h = m.readPosterGridTask.hnumrows
m.testpostergridcontent.appendChild(gridposter)
end sub
sub showpostergrid()
m.testlabel.text = "Here's the PosterGrid: "
m.testpostergrid.content=m.testpostergridcontent
m.testpostergrid.visible=true
m.testpostergrid.setFocus(true)
end sub
]]>
</script>
<children>
<MiniKeyboard id = "exampleMiniKeyboard" />
<Label id="testLabel" translation="[100,32]" text="Building PosterGrid... " />
<PosterGrid
id="testPosterGrid"
translation="[100,100]"
basePosterSize="[240,240]"
itemSpacing="[32,32]"
caption1NumLines="1"
caption2NumLines="1"
numColumns="4"
numRows="3"
/>
</children>
</component>
first read following thinds :
https://developer.roku.com/en-gb/docs/developer-program/discovery/search/implementing-search.md
these code for a search functionality. it applies static way.
sub Main()
''Search Screen UI
'REM ******************************************************
'REM Main routine - example of search screen usage
'REM ******************************************************
print "start"
'toggle the search suggestions vs. search history behavior
'this allow you to generate both versions of the example below
displayHistory = false
history = CreateObject("roArray", 1, true)
'prepopulate the search history with sample results
history.Push("seinfeld")
history.Push("fraiser")
history.Push("cheers")
port = CreateObject("roMessagePort")
screen = CreateObject("roSearchScreen")
'commenting out SetBreadcrumbText() hides breadcrumb on screen
screen.SetBreadcrumbText("", "Search Channel")
screen.SetMessagePort(port)
if displayHistory
screen.SetSearchTermHeaderText("Recent Searches:")
screen.SetSearchButtonText("search")
screen.SetClearButtonText("clear history")
screen.SetClearButtonEnabled(true) 'defaults to true
screen.SetSearchTerms(history)
else
screen.SetSearchTermHeaderText("Suggestions:")
screen.SetSearchButtonText("search")
screen.SetClearButtonEnabled(false)
endif
print "Doing show screen..."
screen.Show()
print "Waiting for a message from the screen..."
' search screen main event loop
done = false
while done = false
msg = wait(0, screen.GetMessagePort())
if type(msg) = "roSearchScreenEvent"
if msg.isScreenClosed()
print "screen closed"
done = true
else if msg.isCleared()
print "search terms cleared"
history.Clear()
else if msg.isPartialResult()
print "partial search: "; msg.GetMessage()
if not displayHistory
screen.SetSearchTerms(GenerateSearchSuggestions(msg.GetMessage()))
endif
else if msg.isFullResult()
print "full search: "; msg.GetMessage()
history.Push(msg.GetMessage())
if displayHistory
screen.AddSearchTerm(msg.GetMessage())
end if
'uncomment to exit the screen after a full search result:
'done = true
else
print "Unknown event: "; msg.GetType(); " msg: "; sg.GetMessage()
endif
endif
endwhile
print "Exiting..."
End Sub
Function GenerateSearchSuggestions(partSearchText As String) As Object
availableContent = [
"ch1"
"ch2"
"ch3"
"ch4"
"ch5"
"ch6"
"ch7"
"ch8"
]
suggestions = []
if partSearchText <> ""
partSearchText = LCase(partSearchText)
for each available in availableContent
if available.Instr(partSearchText) >= 0
suggestions.Push(available)
end if
end for
end if
return suggestions
End Function
End sub
this code writes in main.brs file
I hope this code is helpful.
Most of the search screens in SceenGraph use a combination of MiniKeyboard with a combination of any type of list or grid, such are MarkupGrid. You add these component to your panels or a group component and manage the transition yourself.

Web scraping worked fine in IE 9 but breaks in IE 11

I had a procedure that scraped information from a website in IE9 however after updating to IE11 the procedure breaks when trying to enter a piece of data into
an input box on the webpage. The code recognizes the field and it is listed as on object when I debug but when I try to enter a value into the box using CUSIP.value it does not enter anything on the webpage. I think it has something to do with the source being updated after the browser was updated. I could have sworn that the identifier for "txtCusipNo" in the HTML was listed as an ID instead of a Name. Any help is appreciated. Thanks.
HTML from website
<td class="tbl1">
<INPUT TYPE="TEXT" NAME="txtCusipNo" VALUE="" CLASS="input" SIZE="11" MAXLENGTH="9">
<img src="/RDPANN/pbs/images/lookup.gif" border="0" alt="Open Security Finder" align="absmiddle"> <IMG NAME="txtCusipIMG"SRC="/RDPANN/pbs/images/req.gif" ALIGN="ABSMIDDLE">
</td>
VBA code
Private Sub EnterCUSIP()
Retry:
Set CUSIP = Doc.getElementById("txtCusipNo")
Err.Clear
valA = ActiveSheet.Cells(row, 1)
On Error Resume Next
CUSIP.Value = ActiveSheet.Cells(row, 1) 'insert CUSIP
If Err.Number = 91 Then GoTo Retry
Set CurrentWindow = IE.document.parentWindow
Call CurrentWindow.execScript("javascript:processForm(document.forms.frmSearchEntry)") 'Search (hit enter)
If Err.Number = -2147352319 Then Exit Sub
On Error GoTo 0
Do While (IE.Busy Or IE.READYSTATE <> READYSTATE.READYSTATE_COMPLETE):DoEvents: Loop
End Sub
If you suspect that the HTML source has been changed and may make unannounced changes in the future, I would recommend switching to the ie.Document.All.Item property.
Doc.all.Item("txtCusipNo").Value = 123
The .Item identifier can be either an ID or a Name, there is no distinction between the two. However, I would be concerned that the identifying factor (e.g. txtCusipNo) may not be unique on that page. Yes, it is supposed to be but a growing number of HTML developers are using code like divs(0).getElementById("txtCusipNo") and divs(1).getElementById("txtCusipNo").

classic ASP not seeing vbscript

I have to support an old web server developed in classic ASP and VBScript. I am running on Windows 7 with IIS 7.5.
I followed all the instructions on configuring the IIS from this article.
The web page loads, but it looks like the JS doesn't see functions in VBScript.
I have this code:
<%# Language=VBScript %>
<!-- #include file="HebrewMeta_UTF8.jv"-->
<link rel="stylesheet" type="text/css" href="../Class.css">
<html>
<head>
<%
Nm=Request("Nm")
%>
<title>my page</title>
</head>
<script LANGUAGE="javascript">
var Nm = "<%=Nm%>";
function onCheckPro() {
nm = window.navigator.appName;
if ((nm.indexOf("Explorer") == "-1") && (nm.indexOf("Netscape") == "-1")){
alert(" Compatibility שינוי הגדרות ");
window.open("http://www.comax.co.il/InstallTools/compatibility-view.reg");
//alert("ניתן להפעיל באקספלורר בלבד");
//return;
}
document.all.fr.src = "CheckLogInPro.asp?Kod=" + escape(Kod.value) + "&Pass=" + escape(Pass.value) + "&Date=" + vbDate();
}
</script>
<script LANGUAGE="vbscript">
function vbDate()
vbDate=Cstr(Day(Date()))+"/"+Cstr(Month(Date()))+"/"+Cstr(Year(Date()))+" "+Cstr(hour(Now()))+":"+Cstr(Minute(Now()))+":"+Cstr(Second(Now()))
end function
</script>
I keep on getting "'vbDate' is undefined".
The script language of the site ASP is set to VBScript.
Not an answer, but three warnings:
vbDate is a predefined data type constant; using it to name a function is asking for trouble.
The string concatenation in VBScript is &, not +.
Volatile functions like Date() or Now() shouldn't be used more than once in an expression.
Update wrt comment:
People who like to live dangerously should look at:
WScript.Echo vbDate(), checkType(Now())
Function vbDate()
vbDate = "vbDate is a predefined constant: >" & vbDate & "<"
End Function
Function checkType(x)
Select Case VarType(x)
Case vbDate
checkType = x & " is a date"
Case Else
checkType = x & " is an abomination"
End Select
End Function
output:
cscript xvbdate.vbs
vbDate is a predefined constant: >< 11/14/2014 3:48:17 PM is an abomination
output after changing the function's name:
cscript xvbdate.vbs
vbDate is a predefined constant: >7< 11/14/2014 3:56:57 PM is a date
before using any variable you should give a data type to that variable
dim or var
vbDate
vbDate=Cstr(Day(Date()))+"/"+Cstr(Month(Date()))+"/"+Cstr(Year(Date()))+" "+Cstr(hour(Now()))+":"+Cstr(Minute(Now()))+":"+Cstr(Second(Now()))

Difference between two strings in VBScript

I need a way to find the difference between two strings in a Windows application using VBScript. One of the strings is known but the second one is completely unknown during coding. I know there are functions like StrCompare, InStr etc. but these require you to know the second string also during coding.
Explanation:
There is a text box in the screen and there are several buttons in the same screen. As and when the buttons are clicked, the text in the text box changes depending on the button clicked. Is there a way to find the changes made to the text after the button is clicked ? Basically I need to get the text entered due to the button click. Is there a simple way to do this or it requires complex coding ?
Thanks in Advance.
It depends on your application and the format of the new string.
If you need to find the text appended to the original string, you could take the new text and simply replace the first occurrence of the original string with an empty string:
Dim strOld, strNew, strDiff
strOld = "Apple"
strNew = "Apple, Orange"
strDiff = Replace(strNew, strOld, "", 1, 1)
WScript.Echo strDiff
Sample output:
, Orange
Or if you need to get the appended text without the preceding comma, you could use something like this:
strDiff = Replace(strNew, strOld + ", ", "", 1, 1)
To access (read/write) the content of a HTML text input you need to get the HTML element (document.all.<Name/Id> or document.getElementById(<Name/Id>) and its .value; as in this demo:
<html>
<head>
<Title>readtext</Title>
<hta:application id="readtext" scroll = "no">
<script type="text/vbscript">
Function Change()
document.all.txtDemo.value = "Changed Value"
End Function
Function Check()
Dim txtDemo : Set txtDemo = document.getElementById("txtDemo")
Dim sDemo : sDemo = txtDemo.value
Select Case LCase(Trim(sDemo))
Case "initial value"
MsgBox "still: " & sDemo
Case "changed value"
MsgBox "now: " & sDemo
Case Else
MsgBox "surpise: " & sDemo
End Select
End Function
</script>
</head>
<body>
<input type="text" id="txtDemo" value="Initial Value" />
<hr />
<input type="button" value="Change" onclick="Change" />
<input type="button" value="Check" onclick="Check" />
</body>
</html>

Resources