HTA + vbscript file not getting loaded in window 10 machine - vbscript

I am facing an issue with hta file. In some machine it requires 3 to 5 clicks to get it loaded. Its not due to the slowness or computation in background. As soon as I double click the hta file It will get the user access control(since I am running in admin) to run on Microsoft(R) HTML Application Host. After selecting Yes nothing will happen. This has to do 3-4 times then only the file gets loaded. The below code to elevate the admin right is causing the issue. Thank you in advance for the support.
<script Language="VBScript">
HTAElevate()
Sub Main()
MsgBox "HTA-Ende", 4096
End Sub
Function HTAElevate()
Const Elev = " /elevated"
HTAElevate = True
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
</script>

It's probably a race condition. You're trying to open the same file you already have open, hoping that your HTA will close in time before you open it again as admin. Instead, you should rely on a proxy application to start and wait for your HTA to close, after which it can reopen your HTA as admin. NirCmd is a great free option for this. Here's what I'd do:
// Get a handle on your HTA:APPLICATION tag - we'll need it to get your HTA's path
var HTA = document.getElementsByTagName('HTA:Application')[0];
// This object allows you to invoke a run method
var shell = new ActiveXObject('WScript.Shell');
// Open a command prompt and ping your own machine once, just to stall.
// This buys your HTA some time to close. You can raise the ping count
// by setting -n <number> if you need to wait longer for some reason.
// Once that's done, it'll run nircmdc elevate and re-open your HTA as admin.
// The 2nd argument (0) means hide the command prompt. Set to 1 if you want to see it.
// The 3rd argument (false) means this is an asynchronous call.
shell.run('cmd /c ping localhost -n 1 & c:\\bin\\nircmdc elevate mshta ' + HTA.commandLine, 0, false);
// Close the HTA
window.close();

Related

Creating Simple Custom Context Menu Commands - How can a VB Script be made to run that uses the file path/name that was right clicked?

I downloaded a file and wanted to verify it's MD5 Checksum. 7Zip's file context menu output doesn't include an MD5 checksum, so I downloaded fciv.exe from the Windows site, and copied it into my System32 folder.
Then I went down the rabbit hole of trying to add a custom context menu item. I got as far as to see that I could modify the registry at Computer\HKEY_CLASSES_ROOT*\shell and add a MD5 key with a command key underneath it to execute cmd /k fciv.exe "%1" as a solution.
However, I wanted to go further and use a VB Script to send the output to a simple message box instead of having the console open up. I found code here as follows:
Option Explicit
Const WshRunning = 0
Const WshFinished = 1
Const WshFailed = 2
Dim shell : Set shell = CreateObject("WScript.Shell")
Dim exec : Set exec = shell.Exec("fciv.exe filename-from-right-click")
While exec.Status = WshRunning
WScript.Sleep 50
Wend
Dim output
If exec.Status = WshFailed Then
output = exec.StdErr.ReadAll
Else
output = exec.StdOut.ReadAll
End If
WScript.Echo output
This was where I got stuck:
I have no idea how to adapt the script to use the file path available from the right click menu
and second when I even try to run the script.
When I even try to run the script using the context menu, Windows blocks it with a "This app can't run on your PC" pop-up.
Any suggestions? Bonus points if it's to a dialog box where the text can be copied. Thanks in advance!
Assuming, for example, that you have created c:\temp\md5.vbs (and that your script works!), why don't you set the command value to (by importing this registry):
Windows Registry Editor Version 5.00
[HKEY_CLASSES_ROOT\*\shell\MD5]
#="Get MD5 Checksum"
[HKEY_CLASSES_ROOT\*\shell\MD5\command]
#="wscript.exe \"c:\\temp\\md5.vbs\" \"%1\""
and your script to:
Option Explicit
Const WshRunning = 0
Const WshFinished = 1
Const WshFailed = 2
Dim shell : Set shell = CreateObject("WScript.Shell")
Dim exec : Set exec = shell.Exec("fciv.exe " & chr(34) & Wscript.Arguments(0) & chr(34))
While exec.Status = WshRunning
WScript.Sleep 50
Wend
Dim output
If exec.Status = WshFailed Then
output = exec.StdErr.ReadAll
Else
output = exec.StdOut.ReadAll
InputBox "Copy and paste your MD5 checksum","MD5 Checksum",output
End If
Set exec = Nothing
Set shell = Nothing
This is untested, and you may want to 'variablise' (environment variable?) the location of c:\temp\ in the real world as opposed to a hard coded path...

Is it possible to write a code that opens a program and the login is hidden?

First code: To hide the program when it is running.
Dim WShell
Set WShell = CreateObject("WScript.Shell")
WShell.Run "program name", 0
Set WShell = Nothing
Second code: Runs the program and puts an email and logs in.
Set a = CreateObject("WScript.Shell")
a.Run "program name\"
WScript.Sleep (5000)
a.SendKeys ("email")
a.SendKeys Chr(9)
a.SendKeys "{Enter}"
I am trying to merge the first code with the second code, but I failed
where I want to run the program and login to it via email automatically hidden.
VBScript cannot send keystrokes to hidden windows, meaning what you're asking is not possible in VBScript. It might be possible with AutoIt, though, using the ControlSend method:
Example()
Func Example()
; Run Notepad
Run("notepad.exe")
; Wait 10 seconds for the Notepad window to appear.
Local $hWnd = WinWait("[CLASS:Notepad]", "", 10)
; Wait for 2 seconds.
Sleep(2000)
; Send a string of text to the edit control of Notepad. The handle returned by WinWait is used for the "title" parameter of ControlSend.
ControlSend($hWnd, "", "Edit1", "This is some text")
; Wait for 2 seconds.
Sleep(2000)
; Close the Notepad window using the handle returned by WinWait.
WinClose($hWnd)
; Now a screen will pop up and ask to save the changes, the classname of the window is called
; "#32770" and simulating the "TAB" key to move to the second button in which the "ENTER" is simulated to not "save the file"
WinWaitActive("[CLASS:#32770]")
Sleep(500)
Send("{TAB}{ENTER}")
EndFunc ;==>Example

Creating a script that creates a shortcut and then restarts the computer

I need help with my code. I am trying to make a script that does 2 things: First, it creates shortcut icon on the users desktop. Second, when the user double clicks the icon a box appears asking if they want to restart their computer giving them the option to click OK to restart to CANCEL to cancel the command. When entering the script into the command prompt it just executes the restart computer option. Any help would be greatly appreciated. Here is my script:
Dim answer
' ********* Main processing section **********
' Verify that the user wants to open the Turn Off Computer dialog
Set wshObject = WScript.CreateObject("WScript.Shell")
desktopFolder = wshObject.SpecialFolders("Desktop")
Set myShortcut = wshObject.CreateShortcut(desktopFolder & "\\Shortcut.lnk")
myShortcut.TargetPath = "%windir%\Shortcut.exe"
myShortcut.Save()
answer = MsgBox("The Turn Off Computer dialog will be opened.", 1, "Turn off Computer Script!")
If answer = 1 then ' User clicked on OK
Initiate_Logoff()
End if
' *********** Procedures go here *************
' Open the Windows Turn Off Computer dialog
Function Initiate_Logoff()
shellApp.ShutdownWindows
End Function
How about this:
Option Explicit
'create a desktop shortcut
Dim shl : Set shl = CreateObject("WScript.Shell")
Dim scut : Set scut = shl.CreateShortcut(shl.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\Shortcut.lnk")
scut.TargetPath = "%windir%\shortcut.exe"
scut.Save
Dim cmd : cmd = "shutdown.exe /r /t 1" 'this command restarts the machine
'if the script is being run by cscript (command line)
If InStr(WScript.FullName, "cscript") > 0 Then
shl.Exec cmd
Else
'else ask the user
If MsgBox("Restart Now?", vbQuestion + vbOKCancel, "Title") = vbOK Then
shl.Exec cmd
End If
End If
WScript.Quit

How to click on ok button in message box using vbscript

I have written a simple script to press ok on message box but its not working. Please help me how to do this
here is the sample code
set oWShell = createobject("WScript.Shell")
MsgBox "Hello"
WScript.Sleep 2000
oWShell.Sendkeys "{enter}"
MsgBox waits for the click. If you don't click yourself, it gets never to "Sleep" or "SendKeys".
I assume you are just trying to learn, because this code makes no sense. If you want to press a button on another programs window, this could work. But in its own process this doesn't work.
If you really want to click your own MsgBox, you have to do it with a separate script. One creates the MsgBox and another clicks the button.
If you just want to close a message box after a certain period of time, check out the Popup() method of the WshShell class. Its second parameter specifies the number of seconds to display the message box for before closing it.
With CreateObject("WScript.Shell")
' Display a message box that disappears after two seconds...
.Popup "Hello", 2
End With
chek this site
you need this:
Set objArgs = WScript.Arguments
messageText = objArgs(0)
MsgBox messageText, 51, "Warning......!"
how to click on button in message box and control of display time here the script can do that .
just copy this lines of code and paste in text file then save it as "ControlMsgBox.vbs".
''' IN THE NAME OF ALLAH
' THIS SCRIPT CONTROL OF MSGBOX DISPLAY TIME
' LET SENKEYS DEAL WITH THE MSGBOX
' SOLVE THE PROBLEM OF APPACTIVATE NOT WORKING EFFECTIVE
On Error Resume Next
Dim Sh : Set Sh=CreateObject("wscript.shell") ' declare and create the wshshell
Dim path : path =Replace(WScript.ScriptFullName,WScript.ScriptName,"") 'declare the variable of the current script path
Dim myMessage : myMessage="This is my message ." 'declare variable of the of the display text of msgbox
Sh.run "cmd.exe /c cd """&path&""" && echo msgbox """&myMessage&""",,""hello"" > mymsgbox.vbs",0,false 'create masgbox script in the same path
WScript.Sleep 1000 'wait 1 sec to let process of create msgbox script execute
Sh.run "mymsgbox.vbs" 'run the created msgbox script
WScript.Sleep 3000 ' let the msgbox display for 3 sec before we sendkeys to close
For i=0 To 600 ' loop to retry select correct msgbox window about 1 min
ret = Sh.AppActivate("In_The_Name_Of_Allah") 'select the activate msgbox window (if this loop 300 this mean loop will continue 30 sec if 600 (1 min)
If ret = True Then ' check if the msgbox windows select or not
Sh.SendKeys "%N" 'send key of Alt+N to select first button in msgbox (ok)
End If
ret = Sh.AppActivate("In_The_Name_Of_Allah") 'recheck again to be sure that we will not send key out of target windows (msgbox window)
If ret = True Then
Sh.SendKeys "{enter}" ' send key to click enter
wscript.sleep 500
ret=Sh.AppActivate("In_The_Name_Of_Allah")
If ret=False Then ' using nested IF to sure of selected windows is false because its close
Exit For ' exit for loop directly and execute what after for next
End If
End If
WScript.Sleep 100
Next
With CreateObject("Scripting.FileSystemObject")
If .FileExists(path&"mymsgbox.vbs") Then 'check if the msgbox script we create form this script exist or not
.DeleteFile(path&"mymsgbox.vbs") 'delete the msgbox script we create after message window closed
End If
End With
Set Sh=Nothing 'remove the sh object create
WScript.Quit ' terminate wscript.exe instance who run this script

Run script in background

I want to run following script as scheduled task on Windows 7 in background. Now, script displays cmd window and, can I run script without visible cmd window?
Option Explicit
Dim WshShell, oExec
Dim RegexParse
Dim hasError : hasError = 0
Set WshShell = WScript.CreateObject("WScript.Shell")
Set RegexParse = New RegExp
Set oExec = WshShell.Exec("%comspec% /c echo list volume | diskpart.exe")
RegexParse.Pattern = "\s\s(Volume\s\d)\s+([A-Z])\s+(.*)\s\s(NTFS|FAT)\s+(Mirror|RAID-5)\s+(\d+)\s+(..)\s\s([A-Za-z]*\s?[A-Za-z]*)(\s\s)*.*"
While Not oExec.StdOut.AtEndOfStream
Dim regexMatches
Dim Volume, Drive, Description, Redundancy, RaidStatus
Dim CurrentLine : CurrentLine = oExec.StdOut.ReadLine
Set regexMatches = RegexParse.Execute(CurrentLine)
If (regexMatches.Count > 0) Then
Dim match
Set match = regexMatches(0)
If match.SubMatches.Count >= 8 Then
Volume = match.SubMatches(0)
Drive = match.SubMatches(1)
Description = Trim(match.SubMatches(2))
Redundancy = match.SubMatches(4)
RaidStatus = Trim(match.SubMatches(7))
End If
If RaidStatus <> "Healthy" Then
hasError = 1
'WScript.StdOut.Write "WARNING "
MsgBox "Status of " & Redundancy & " " & Drive & ": (" & Description & ") is """ & RaidStatus & """", 16, "RAID error"
End If
End If
Wend
WScript.Quit(hasError)
Thanks a lot
Option 1 - If the task is running under your user credentials (if not, msgbox will not be visible)
There are two possible sources for the cmd window.
a) The script itself. If the task is executing cscript, the console window will be visible, avoid it calling wscript instead
b) The Shell.exec call. The only way to hide this window is to start the calling script hidden. On start of your script test for the presence of certain argument. If not present, make the script call itself with the argument, using Run method of the WshShell object, and indicating to run the script with hidden window. Second instance of the script will start with the special parameter, so it will run, but this time windows will be hidden.
Option 2 - Running the task under system credentials.
In this case, no window will be visible. All will be running in a separate session. BUT msgbox will not be seen. Change MsgBox call with a call to msg.exe and send a message to current console user.

Resources