A new HTA based message box [VbScript]

Prev: A new HTA based message box
Next: VBScript to add local accounts on multiple machines

From: Tom Lavedas on 29 Jun 2010 16:51

On Jun 29, 4:23 pm, "Pegasus [MVP]" <n...(a)microsoft.com> wrote:
> "Tom Lavedas" <tglba...(a)verizon.net> wrote in message
>
> news:b9622e6d-0213-4d67-824c-e3d07fb17416(a)k39g2000yqb.googlegroups.com...
>
>
>
> > About ten days ago I adapted a Mayayana solution to create a
> > "chromeless" msgbox replacement. The thread can be found here:
> >http://groups.google.com/group/microsoft.public.scripting.vbscript/br.....
>
> > At the time I figured the only thing objectionable about the approach
> > was that it flashed a large HTA window before it could be adjusted to
> > the desired size. I asked if anyone might have a solution. Having
> > received no response, I kept thinking about that problem. I was
> > pretty sure a fix could be coded into the JavaScript used to create
> > the HTA in the first place, but couldn't get it to work. Today I had
> > a 'eureka' moment and after some fiddling got it worked out.
>
> > Hear is an example that presents a request for credentials and
> > provides a simple UID/Password dialog box as an example of its use
> > (watch for wordwrap) ...
>
> > ' A simple example of HTABox
> > -----------' Main -------------
> > with HTABox("lightgrey", 150, 300, 400, 500)
> > .document.title = "Credentials"
> > .msg.innerHTML = "UserID:     <input type=text size=20
> > id=UID>"_
> > & "<br>Password: <input type=password id=PW
> > size=22><p>" _
> > & "<input type=submit value=Submit
> > onclick='done.value=true'>"
> > .UID.value = createobject("wscript.network").username
> > .PW.focus
> > do until .done.value : wsh.sleep 50 : loop
> > sUID = .UID.value : sPW = .PW.value
> > .close
> > end with
>
> > wsh.echo "UID:", sUID, "Password:", sPW
> > '--------- Main Ends ------------
>
> > ' Author: Tom Lavedas, June 2010
> > Function HTABox(sBgColor, h, w, l, t)
> > Dim IE, HTA
>
> > randomize : nRnd = Int(1000000 * rnd)
> > sCmd = "mshta.exe ""javascript:" _
> > & "{with (new ActiveXObject(""InternetExplorer.Application""))
> > {" _
> > & "PutProperty('" & nRnd & "',window);" _
> > & "with (GetProperty('" & nRnd & "')){" _
> > & "resizeTo(" & w & "," & h & ");moveTo(" & l & "," & t &
> > ")}}}"""
>
> > with CreateObject("WScript.Shell")
> > .Run sCmd, 1, False
> > do until .AppActivate("javascript:{with ") : WSH.sleep 10 : loop
> > end with ' WSHShell
>
> > For Each IE In CreateObject("Shell.Application").windows
> > If IsObject(IE.GetProperty(nRnd)) Then
> > set HTABox = IE.GetProperty(nRnd)
> > HTABox.document.title = "HTABox"
> > HTABox.document.write _
> > "<HTA:Application contextMenu=no border=thin " _
> > & "minimizebutton=no maximizebutton=no sysmenu=no />" _
> > & "<body scroll=no style='background-color:" _
> > & sBgColor & ";font:normal 10pt Arial' " _
> > & "onbeforeunload='vbscript:if not done.value then " _
> > & "window.event.cancelBubble=true:" _
> > & "window.event.returnValue=false:" _
> > & "done.value=true:end if'>" _
> > & "<input type=hidden id=done value=false>" _
> > & "<center><span id=msg> </span><center></body>"
> > Exit Function
> > End If
> > Next
>
> > ' I can't imagine how this line can be reached, but just in case
> > MsgBox "HTA window not found." : wsh.quit
>
> > End Function
> > ' ---------- code ends -------------
>
> > I chose to make the dialog box as simple as possible, purposely devoid
> > of 'bells and whistles'. It merely returns a handle to the HTA window
> > that is created. It does provided some fundamental features such as
> > the setting of background color, height, width, left position and top
> > position. The actual controls for the object are left to the user to
> > define through the 'msg' object that the routine creates. A user's
> > intention to continue is signaled via the hidden 'done' control, by
> > setting its value to True. However, a script is free to close the
> > window at any time by issuing a 'close' command. The script example
> > provides some illustrative code and logic.
>
> > Enjoy.
> > _____________________
> > Tom Lavedas
>
> This is great stuff and I have been looking for something like this for
> quite some time. It is fairly easy to adapt the code for different
> applications even for someone like me who knows nothing at all about HTA and
> Java. However, I do have a problem with an application that requires a
> banner panel across the top of the screen. Just an informative message, no
> OK button. It runs in parallel with some independent process. To close the
> panel I replace this line
>
> do until .done.value : wsh.sleep 50 : loop
>
> with something like this:
>
> do until oFSO.FileExists(sSemaphore) : loop
>
> where the semaphore file is created by the parallel process. This works but
> here is a snag: The moment the program drops out of the Do loop, IE
> generates a dialog box asking if I really want to close the current window.
> How can I prevent this box from popping up?

Immediately before your script issues the Close, set the value of
'done' equal to True, as in ...

with HTABox (...)
do until oFSO.FileExists(sSemaphore) : loop
.done.value = true
.close
end with

Obviously, I didn't test that ;-}
_____________________
Tom Lavedas

From: Pegasus [MVP] on 29 Jun 2010 17:30

>
> Immediately before your script issues the Close, set the value of
> 'done' equal to True, as in ...
>
> with HTABox (...)
> do until oFSO.FileExists(sSemaphore) : loop
> .done.value = true
> .close
> end with
>
> Obviously, I didn't test that ;-}
> _____________________
> Tom Lavedas

I just tested it myself - works like a charm. Thanks for the quick response!

From: Tom Lavedas on 29 Jun 2010 22:34

On Jun 29, 5:30 pm, "Pegasus [MVP]" <n...(a)microsoft.com> wrote:
> > Immediately before your script issues the Close, set the value of
> > 'done' equal to True, as in ...
>
> > with HTABox (...)
> > do until oFSO.FileExists(sSemaphore) : loop
> > .done.value = true
> > .close
> > end with
>
> > Obviously, I didn't test that ;-}
> > _____________________
> > Tom Lavedas
>
> I just tested it myself - works like a charm. Thanks for the quick response!

Glad I could help.

BTW, I tweaked the code a bit (I figured out that the JavaScript part
could be simplified):

with HTABox("lightgrey", 150, 300, 400, 500)
.document.title = "Credentials"
.msg.innerHTML = "UserID:     <input type=text size=20
id=UID>"_
& "<br>Password: <input type=password id=PW
size=22><p>" _
& "<input type=submit value=Submit
onclick='done.value=true'>"
.UID.value = createobject("wscript.network").username
.PW.focus
do until .done.value : wsh.sleep 50 : loop
sUID = .UID.value : sPW = .PW.value
.done.value = true ' Only needed if box to be closed before return
.close
end with

wsh.echo "UID:", sUID, "Password:", sPW

Function HTABox(sBgColor, h, w, l, t)
Dim IE, HTA

randomize : nRnd = Int(1000000 * rnd)
sCmd = "mshta.exe ""javascript:{new " _
& "ActiveXObject(""InternetExplorer.Application"")" _
& ".PutProperty('" & nRnd & "',window);" _
& "window.resizeTo(" & w & "," & h & ");" _
& "window.moveTo(" & l & "," & t & ")}"""

with CreateObject("WScript.Shell")
.Run sCmd, 1, False
do until .AppActivate("javascript:{new ") : WSH.sleep 10 : loop
end with ' WSHShell

For Each IE In CreateObject("Shell.Application").windows
If IsObject(IE.GetProperty(nRnd)) Then
set HTABox = IE.GetProperty(nRnd)
HTABox.document.title = "HTABox"
HTABox.document.write _
"<HTA:Application contextMenu=no border=thin " _
& "minimizebutton=no maximizebutton=no sysmenu=no />" _
& "<body scroll=no style='background-color:" _
& sBgColor & ";font:normal 10pt Arial;" _
& "border-Style:outset;border-Width:3px'" _
& "onbeforeunload='vbscript:if not done.value then " _
& "window.event.cancelBubble=true:" _
& "window.event.returnValue=false:" _
& "done.value=true:end if'>" _
& "<input type=hidden id=done value=false>" _
& "<center><span id=msg> </span><center></body>"
Exit Function
End If
Next

' I can't imagine how this line can be reached, but just in case
MsgBox "HTA window not found."
wsh.quit

End Function
__________________
Tom Lavedas

From: Tom Lavedas on 30 Jun 2010 08:32

On Jun 25, 10:27 pm, "Todd Vargo" <tlva...(a)sbcglobal.netz> wrote:
> James Whitlow wrote:
> > "Tom Lavedas" <tglba...(a)verizon.net> wrote in message
> >news:b9622e6d-0213-4d67-824c-e3d07fb17416(a)k39g2000yqb.googlegroups.com....
> >> About ten days ago I adapted a Mayayana solution to create a
> >> "chromeless" msgbox replacement. The thread can be found here:
>
> snip...
>
> >> At the time I figured the only thing objectionable about the approach
> >> was that it flashed a large HTA window before it could be adjusted to
> >> the desired size. I asked if anyone might have a solution. Having
> >> received no response, I kept thinking about that problem. I was
> >> pretty sure a fix could be coded into the JavaScript used to create
> >> the HTA in the first place, but couldn't get it to work. Today I had
> >> a 'eureka' moment and after some fiddling got it worked out.
>
> > Nice piece of work, Tom!
>
> > I don't really have a need for the message box, per se, but I will likely
> > be borrowing your technique for some other projects. Having an HTA
> > launched from a WSF really opens the door to being able to have pseudo
> > multi-threaded HTA. The entire body of the HTA can be neatly packaged
> > inside of a <resource> in the WSF.
>
> Yes, nice work Tom. The only thing that bothers me is when run using the
> WSCRIPT.EXE host, after the HTA closes and control returns to the script,
> the window focus does not return to the running script. In otherwords, any
> MsgBox thereafter will be opened as minimized. The only thing that seems to
> display the MsgBox in the foreground following the HTA is if the
> vbSystemModal flag is used.
>
> --
> Todd Vargo
>
> (Post questions to group only. Remove "z" to email personal messages)

You could just reuse the same HTABox to display your results,
something like this ...

with HTABox("lightgrey", 150, 300, 400, 500)
.document.title = "Credentials"
.msg.innerHTML = "UserID:     " _
& "<input type=text size=20 id=UID>"_
& "<br>Password: <input type=password id=PW size=22><p>" _
& "<input type=submit value=Submit onclick='done.value=true'>"
.UID.value = createobject("wscript.network").username
.PW.focus
do until .done.value : wsh.sleep 50 : loop
sUID = .UID.value : sPW = .PW.value

' Show the results by reusing the HTABox
' Optionally change box style parameters
.resizeto 250, 125 : .moveto 500, 400
.document.body.style.borderwidth = "1px"
.document.title = "Results"
.msg.innerHTML = "UID: " & sUID & " Password: " & sPW & "<p>" _
& "<input type=submit id=ok value=OK onclick='done.value=true'>"
.done.value = false ' reset exit control to wait
timeout = 3000 ' set an automatic close timeout
.OK.focus
do until .done.value or n > TimeOut: wsh.sleep 50 : n=n+50 : loop
.done.value = true ' suppress IE close message
.close
end with
_____________________
Tom Lavedas

From: Rems on 30 Jun 2010 11:11

On 26 jun, 04:27, "Todd Vargo" <tlva...(a)sbcglobal.netz> wrote:

> > Nice piece of work, Tom!
>
> > I don't really have a need for themessagebox, per se, but I will likely
> > be borrowing your technique for some other projects. Having anHTA
> > launched from a WSF really opens the door to being able to have pseudo
> > multi-threadedHTA. The entire body of theHTAcan be neatly packaged
> > inside of a <resource> in the WSF.
>
> Yes, nice work Tom. The only thing that bothers me is when run using the
> WSCRIPT.EXE host, after theHTAcloses and control returns to the script,
> the window focus does not return to the running script. In otherwords, any
> MsgBox thereafter will be opened as minimized. The only thing that seems to
> display the MsgBox in the foreground following theHTAis if the
> vbSystemModal flag is used.
>
> --
> Todd Vargo
>
> (Post questions to group only. Remove "z" to email personal messages)- Tekst uit oorspronkelijk bericht niet weergeven -
>
> - Tekst uit oorspronkelijk bericht weergeven -

There is a somewhat ugly workaround to get the focus back to
wscript.exe => .sendkeys "^"

Awesome piece of work Tom!

I noticed when I test the script that iexplore.exe processes where not
quit after the script is ended.
Therefore I added IE.quit to the script.

I also perform a resize of the box twice - the first time there is
just a minimal box centered on the screen.
And after the color of the body has been set, the script resize the
box to its final size.
Additionally the intWindowStyle for CreateObject("WScript.Shell").RUN
have I set to 2

A sample is below (sorry for the other changes, these are personal),

' A simple example of HTABox --------------------------------

Dim IE
sWidth = 300
sHeight = 210

with HTABox(sHeight, sWidth)
.document.title = String(18, chr(160)) & "Credentials"
.msg.innerHTML = "UserID:     <input type=text " _
& "size=20 id=UID><br>Password: <input "_
& "type=password id=PW size=22><p><input " _
& "type=submit value=Submit onclick=" _
& "'done.value=true'>"
.UID.value = createobject("wscript.network").username
.PW.focus
do until .done.value : wsh.sleep 50 : loop
sUID = .UID.value : sPW = .PW.value
.close
end with
IE.quit : CreateObject("WScript.Shell").SendKeys "^"

wsh.echo "UID:", sUID, "Password:", sPW

'--------- Main Ends ------------

' Author: Tom Lavedas, June 2010
Function HTABox(h, w)
Dim l, t
With createobject("internetexplorer.application")
l = .width
t = .height
.quit
End with

Dim IHTA
nRnd = hex(Timer*100)

sCmd = "mshta.exe ""javascript:{new " _
& "ActiveXObject(""InternetExplorer.Application"")" _
& ".PutProperty('" & nRnd & "',window);" _
& "window.resizeTo();window.moveTo(" & l/2 & "," & t/2 & ")}"""

with CreateObject("WScript.Shell")
.Run sCmd, 2, False
do until .AppActivate("javascript:{new ") : WSH.sleep 10 : loop
end with ' WSHShell

For Each IE In CreateObject("Shell.Application").windows
If IsObject(IE.GetProperty(nRnd)) Then
set HTABox = IE.GetProperty(nRnd)
HTABox.document.title = "HTABox"
HTABox.document.write _
"<HTA:Application contextMenu=no border=thin " _
& "minimizebutton=no maximizebutton=no sysmenu=no />" _
& "<body scroll=no style=filter:progid:DXImageTrans" _
& "form.Microsoft.Gradient(GradientType=0,StartColor" _
& "Str='#86cceb',endColorStr='#5589ab');font:normal " _
& "10pt Arial' onbeforeunload='vbscript:if not done." _
& "value then window.event.cancelBubble=true:" _
& "window.event.returnValue=false:" _
& "done.value=true:end if'>" _
& "<input type=hidden id=done value=false>" _
& "<center><span id=msg> </span><center></body>"

l = (l - w) /2
t = (t - h) /2
HTABox.moveTo l,t
HTABox.resizeTo w,h
Exit Function
End If
Next

' I can't imagine how this line can be reached, but just in case
MsgBox "HTA window not found." : wsh.quit

End Function
' ---------- code ends -------------

\Rems

First | Prev | Next | Last
Pages: 1 2 3
Prev: A new HTA based message box
Next: VBScript to add local accounts on multiple machines