Thread: Dynamic HTA
View Single Post
  #6  
Old 05-08-2014, 01:56 PM
krillik krillik is offline
Registered User
 
Join Date: May 2013
Posts: 13
Code

As requested here is the code I modified, I am no expert but it does not seem to thrown any errors or anything when I run it.

Code:
sMessage = "<font color=red><b>This is your important message</b></font>"
sControl = "<input type=button id=Btn1 value=OK onclick='done.value=""clicked""'>"
sHTMLCode = sMessage & "<hr>" & sControl
'
with HTABox("lightgrey", 125, 300, 400, 500)
  .document.title = "My Message Box"
  .msg.innerHTML = sHTMLCode
  Timeout = 3000 ' milliseconds
  do until .done.value = "clicked" or (n > TimeOut): crt.sleep 50 : n=n+50 : loop
  if .done.value = "clicked" then 
    crt.Dialog.Messagebox("User pressed button")
  else
    crt.Dialog.Messagebox("Timed out")
  end if
  .done.value = true
  .close
end with
'
' Author Tom Lavedas, June 2010
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 ") : crt.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)
      IE.Quit
      HTABox.document.title = "HTABox"
      HTABox.document.write _
               "<HTA:Application contextMenu=no border=thin " _
             & "minimizebutton=no maximizebutton=no sysmenu=yes />" _
             & "<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>&nbsp;</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."
End Function

Last edited by krillik; 05-08-2014 at 02:03 PM. Reason: Made a mistake in code, removed it
Reply With Quote