vbscripthta

How to run an HTA dialog with a UAC prompt and wait for a return value


Is it possible to run part of hta file with administrator's privilege? I will like to make it in a way that when i click on ADD TIME button it should prompt me to provide administrators details. I have tried several ways but not working. There are some of the ways i have tried but it gives me an error and others will not respond to the call to run as administrator. I will be grateful for your assistance.

Here is the file

<!DOCTYPE html>
<html>
<title >Time remaining</title>
<head>

<meta charset="UTF-8" http-equiv="X-UA-Compatible" content="IE=9">
<hta:application
  applicationname="Time remaining" 
  id=oHTA
  maximizebutton=no
  windowstate="normal"
  scroll=no
  SysMenu=no
>
<script language="VBScript">
    Const DefaultWait = 30 'minutes
    Const LogoffCmd = "Shutdown.exe /l /f"
    Const RestartCmd = "Shutdown.exe -r -f"
    Const ShutdownCmd = "shutdown.exe /s /t"
    Const Logoff = True
    Const Unattended = True
    Const TestMode = False
    Const HKCU = &H80000001
    Set oWSH = CreateObject("Wscript.Shell")
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oReg = GetObject("winmgmts:\\.\root\default:StdRegProv")
    Dim TimeLeftInSeconds,WaitTimer,Wait,PrevWait
    MyPath  = Mid(document.URL,8)
    MyName = oFSO.GetFileName(MyPath)
    MyFolder = oFSO.GetParentFolderName(MyPath)
    oWSH.CurrentDirectory = MyFolder
    document.Title = MyName
    Scale = GetScale()
    w = 300 * Scale: h = 250 * Scale
    Window.ResizeTo w, h
    Window.MoveTo (screen.availWidth - w)/2, (screen.availHeight - h)/2
    
    Sub RunAsAdmin
        If InStr(LCase(oHTA.commandLine), " /elevated") = 0 Then
            createobject("Shell.Application").ShellExecute "mshta.exe", oHTA.commandLine & " /elevated", "", "runas", 4
            self.close
        End If
    End Sub
    
    Sub window_onLoad
      ShutdownOption(0).style.zoom = Scale
      ShutdownOption(1).style.zoom = Scale
      ShutdownOption(2).style.zoom = Scale
      Wait = DefaultWait
      WaitBox.Value = Wait
      TimeLeftInSeconds = Wait * 60
      WaitBox.select
      If Unattended Then
        UpdateCountdown
        WaitTimer = Window.SetInterval("UpdateCountdown()", 1000)
      End If
      ShutdownOption(0).checked = True
      If Restart Then ShutdownOption(1).checked = True
      If Shutdown Then ShutdownOption(2).checked = True
    End Sub
    Sub document_onKeyDown
      If window.event.keyCode=13 Then RestartCountdown
    End Sub
    Sub ReSelectInput
      WaitBox.select
    End Sub
    Sub UpdateCountdown
      Hours = CInt(TimeLeftInSeconds \ 3600)
      Minutes = CInt((TimeLeftInSeconds Mod 3600) \ 60)
      Seconds = TimeLeftInSeconds Mod 60
      CountDown.innerHTML = Hours & ":" & Right("0" & Minutes,2) & ":" & Right("0" & Seconds,2)
      If TimeLeftInSeconds<=0 Then
        Cmd = LogoffCmd
        If ShutdownOption(1).checked Then Cmd = RestartCmd
        If ShutdownOption(2).checked Then Cmd = ShutdownCmd
        If TestMode Then
          MsgBox Cmd
        Else
          oWSH.Run Cmd,1,False
        End If
        self.Close
        Exit Sub
      End If
      TimeLeftInSeconds = TimeLeftInSeconds - 1
    End Sub
    Sub RestartCountdown
      If WaitTimer="" Then WaitTimer = Window.SetInterval("UpdateCountdown()", 1000)
      WaitBox.select
      If Not IsNumeric(Replace(WaitBox.Value,":",".")) Then
        WaitBox.Value = PrevWait
        WaitBox.select
        Exit Sub
      End If
      PrevWait = WaitBox.Value
      Wait = WaitBox.Value
      If InStr(Wait,":")>0 Then
        aWait = Split(Wait,":")
        Wait = aWait(0)*60 + aWait(1)
      End If
      TimeLeftInSeconds = Wait * 60
      UpdateCountdown
    End Sub
    
    Function GetScale()
      GetScale = 1.0
      Value = oWSH.RegRead("HKCU\Control Panel\Desktop\WindowMetrics\AppliedDPI")
      If Value > 96 Then
        'Custom scaling is set
        GetScale = Value/96
      Else
        'See if standard scaling is set
        Key = "Control Panel\Desktop\PerMonitorSettings"
        Result = oReg.EnumKey(HKCU, Key, ArrKeys)
        If Result=0 Then
          'Assume first monitor in list is the one we want
          For Each SubKey In ArrKeys
            Exit For
          Next
          Value = oWSH.RegRead("HKCU\" & Key & "\" & SubKey & "\DPIValue")
          If Value>0 Then GetScale = 1 + (Value * 0.25)
        End If
      End If
    End Function
    
    


</script>
<style>
  .body {background-color:Lavender; font-family:Segoe UI; font-size:11pt, justify-content: center;}
  h1 {color:red; text-align: center;}
  .button {width:6em}
  .radio {vertical-align:bottom}
  /* The Modal (background) */
.modal {
  display: none; /* Hidden by default */
  position: fixed; /* Stay in place */
  z-index: 1; /* Sit on top */
  padding-top: 0px; /* Location of the box */
  left: 0;
  top: 0;
  width: 90%; /* Full width */
  height: 60%; /* Full height */
  overflow: auto; /* Enable scroll if needed */
  background-color: rgb(0,0,0); /* Fallback color */
  background-color: rgba(0,0,0,0.4); /* Black w/ opacity */
}

/* Modal Content */
.modal-content {
  background-color: #fefefe;
  margin: auto;
  padding: 20px;
  border: 1px solid #888;
  width: 80%;
  text-align: center;
}

/* The Close Button */
.close {
  color: #aaaaaa;
  float: right;
  font-size: 28px;
  font-weight: bold;
}

.close:hover,
.close:focus {
  color: #000;
  text-decoration: none;
  cursor: pointer;
}

</style>
</head>
<body>
 <div class="timer"> <h1 id=CountDown>&nbsp </h1></div>

<button id="myBtn" value="Add Time" onClick=RunAsAdmin()> Add Time</button>

<div id="myModal" class="modal">
     

  <div class="modal-content">
    <span class="close">&times;</span>
 Enter minutes to be added<br><br>
  
  <input type=text size=8 id=WaitBox>
  <input type=button class=button id=OKButton value="OK" onClick=RestartCountdown()><br><br>
  <input type=radio class=radio name=ShutdownOption onClick=ReSelectInput()>Logoff&nbsp
  <input type=radio class=radio name=ShutdownOption onClick=ReSelectInput()>Restart&nbsp
  <br><input type=radio class=radio name=ShutdownOption onClick=ReSelectInput()>Shutdown
  </div>
</div>
  
 <script>

    var modal = document.getElementById("myModal");

    var btn = document.getElementById("myBtn");

    var span = document.getElementsByClassName("close")[0];

    btn.onclick = function() {
      modal.style.display = "block";
    }

    span.onclick = function() {
      modal.style.display = "none";
    }

    window.onclick = function(event) {
      if (event.target == modal) {
        modal.style.display = "none";
      }
    }
    
</script>
</body>
</html>

Solution

  • Here's your script rewritten to run a separate HTA for the "Add Time" dialog with elevated privileges.

    The original version I posted used a flag file to determine when the called script exited. However that method has a fatal flaw. If the user clicks "No" at the UAC prompt, the called script will never run and the calling script will wait forever.

    I solved this by using the elevate.exe command line tool to run AddTime.hta. Elevate.exe provides a -wait4exit option so we can just use the standard Run method with True set for the wait on return and elevate.exe takes care of the rest.

    The data (minutes to add) and a timestamp are passed back via HKLM so we securely get the added time value but don't add it again if "No" is clicked at the UAC prompt.

    The two main scripts are posted below.

    The complete package is posted here.

    TimeRemaining.hta

    <!DOCTYPE html>
    <html>
    <title>Time remaining</title>
    <head>
    <meta charset="UTF-8" http-equiv="X-UA-Compatible" content="IE=9">
    <hta:application
      id=oHTA
      icon=perfmon.exe
      applicationname=TimeRemaining
      scroll=no
      contextmenu=no
      showintaskbar=yes
      minimizeButton=yes
      maximizeButton=no
      singleinstance=yes
      SysMenu=no
    >
    <script language="VBScript">
    Const DefaultWait = 30 'minutes
    Const AddTimeStart = 120 'seconds
    Const WarningTime = 120 'seconds
    
    Set oWSH = CreateObject("Wscript.Shell")
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oNet = CreateObject("WScript.Network")
    
    Dim TimeLeftInSeconds,WaitTimer
    MyFolder = oFSO.GetParentFolderName(Mid(document.URL,8))
    oWSH.CurrentDirectory = MyFolder
    AddTimeHTA = MyFolder & "\AddTime.hta"
    logoutcmd = "Shutdown.exe -l -f"
    Scale = GetScale()
    w = 300 * Scale: h = 110 * Scale
    Window.ResizeTo w, h
    Window.MoveTo (screen.availWidth - w)/2, (screen.availHeight - h)/2
    Paused = False
    
    If InStr(MyFolder," ")>0 Then
      MsgBox "This script must be run from a folder with no spaces in its name",vbExclamation,"Error"
      self.close
    End If
    
    Architecture = oWSH.environment("PROCESS").item("PROCESSOR_ARCHITECTURE")
    SystemRoot = oWSH.ExpandEnvironmentStrings("%SystemRoot%")
    WOWPath = SystemRoot & "\SysWOW64\"
    ExePath = SystemRoot & "\System32\"
    ElevateExe = "elevate.exe"
    If Architecture="AMD64" Then ElevateExe = "elevate64.exe"
    If Architecture="x86" And oFSO.FolderExists(WOWPath) Then ExePath = WOWPath
    
    MySID = GetObject("winmgmts:\root\cimv2:Win32_UserAccount.Domain='" & oNet.UserDomain & "',Name='" & oNet.UserName & "'").SID
    
    TimeLeftInSeconds = DefaultWait * 60
    On Error Resume Next
    RegTimeLeft = oWSH.RegRead("HKCU\Software\TimeRemainingHTA\TimeLeftInSeconds")
    TimeStamp = oWSH.RegRead("HKLM\Software\TimeRemainingHTA\TimeStamp\" & MySID)
    On Error Goto 0
    If IsNumeric(RegTimeLeft) And IsDate(TimeStamp) Then
      TimeSinceLastEntry = DateDiff("s",TimeStamp,Now())
      If TimeSinceLastEntry<2 Then TimeLeftInSeconds = RegTimeLeft
    End If
    
    Sub window_onLoad
      UpdateCountdown
      WaitTimer = Window.SetInterval("UpdateCountdown()", 1000)
    End Sub
    
    Function document_onKeyDown()
      If window.event.keyCode=115 Or window.event.keyCode=116 Then
        window.event.keyCode = 0
        document_onKeyDown = False
      End If
    End Function
    
    Sub UpdateCountdown
      If Not Paused Then
        If TimeLeftInSeconds=AddTimeStart Then
          Window.ResizeTo w, 150 * Scale
          AddTimeButton.Style.Display = "inline"
        End If
        Hours = CInt(TimeLeftInSeconds \ 3600)
        Minutes = CInt((TimeLeftInSeconds Mod 3600) \ 60)
        Seconds = TimeLeftInSeconds Mod 60
        CountDown.innerHTML = Hours & ":" & Right("0" & Minutes,2) & ":" & Right("0" & Seconds,2)
        If TimeLeftInSeconds<0 Then
          oWSH.Run logoutcmd,1,False
          self.Close
          Exit Sub
        End If
        TimeLeftInSeconds = TimeLeftInSeconds - 1
        oWSH.RegWrite "HKCU\Software\TimeRemainingHTA\TimeLeftInSeconds",TimeLeftInSeconds
        If TimeLeftInSeconds=WarningTime Then oWSH.Run "Powershell.exe -NoLogo -ExecutionPolicy Bypass -File .\Warning.ps1",0,False
      End If
    End Sub
    
    Function GetScale()
      GetScale = 1.0
      On Error Resume Next
      'If user changes scale, they must logout/login for this registry value to change
      GetScale = oWSH.RegRead("HKCU\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 96
      On Error Goto 0
    End Function
    
    Sub AddTime
      Paused = True
      oWSH.RegWrite "HKCU\Software\TimeRemainingHTA\TimeLeftInSeconds",0
      oWSH.Run ElevateExe & " -wait4exit " & ExePath & "mshta.exe """ & AddTimeHTA & """ " & window.screenLeft & " " & window.screenTop & " " & Scale & " " & MySID,0,True
      On Error Resume Next
      MinutesToAdd = oWSH.RegRead("HKLM\Software\TimeRemainingHTA\AddTime\" & MySID)
      TimeStamp = oWSH.RegRead("HKLM\Software\TimeRemainingHTA\TimeStamp\" & MySID)
      TimeSinceLastEntry = DateDiff("s",TimeStamp,Now())
      On Error Goto 0
      If IsNumeric(MinutesToAdd) And TimeSinceLastEntry<2 Then 
        TimeLeftInSeconds = TimeLeftInSeconds + Int(MinutesToAdd * 60)
      End If
      Paused = False
    End Sub
    
    </script>
    <style>
    body {background-color:black; font-family:Segoe UI; font-size:11pt}
    h1 {color:red}
    .timerDiv {text-align:center}
    #AddTimeButton {width:6em; display:none}
    </style>
    </head>
    <body>
      <div class=timerDiv>
        <h1 id=CountDown></h1>
        <input id=AddTimeButton type=button value='Add Time' OnClick=AddTime()>
      </div>
    </body>
    </html>
    

    AddTime.hta

    <!DOCTYPE html>
    <html>
    <head>
    <title >Add Time</title>
    <meta charset="UTF-8" http-equiv="X-UA-Compatible" content="IE=9">
    <hta:application
      id=oHTA
      icon=perfmon.exe
      scroll=no
      contextmenu=no
      showintaskbar=no
      minimizeButton=no
      maximizeButton=no
      SysMenu=yes
    >
    <script language="VBScript">
    Set oWSH = CreateObject("Wscript.Shell")
    
    aCmd = Split(oHTA.commandLine)
    If UBound(aCmd)<3 Then self.Close
    
    x = aCmd(1)
    y = aCmd(2)
    Scale = aCmd(3)
    MySID = aCmd(4)
    w = 300 * Scale: h = 150 * Scale
    Window.MoveTo x,y
    Window.ResizeTo w,h
    
    Sub document_onKeyDown
      If window.event.keyCode=13 Then window.event.keyCode = 0: Done
      If window.event.keyCode=27 Then window.event.keyCode = 0: self.Close
    End Sub
    
    Sub window_onLoad
      AddTime.focus
    End Sub
    
    Sub Done
      oWSH.RegWrite "HKLM\Software\TimeRemainingHTA\TimeStamp\" & MySID,Now()
      oWSH.RegWrite "HKLM\Software\TimeRemainingHTA\AddTime\" & MySID,AddTime.Value
      self.Close
    End Sub
    
    </script>
    <style>
    body {color:red; background-color:black; font-family:Segoe UI; font-size:11pt}
    .timer {text-align:center}
    </style>
    </head>
    <body>
      <div class=timer>
        Enter minutes to be added:<br><br>
        <input id=AddTime type=text size=4 maxlength=4>
        <input type=button Value=OK OnClick=Done()>
      </div>
    </body>
    </html>