I am trying to launch an application from the Windows shell using VBScript. The application runs without errors when run from QtCreator. However, it crashes when run from VBScript and exits with error code 255.
Here's the script:
Set objShell = WScript.CreateObject("WScript.Shell")
rv = objShell.Run("path\to\application.exe", 1 , True)
If rv <> 0 Then
MsgBox "Failed : " & rv
End If
WScript.Sleep 120000
objShell.Run "taskkill /im path\to\application.exe"
Set objShell = Nothing
Could someone please point out what I am missing?
Give a try for this vbscript and tell me the result :
Option Explicit
Dim Title,objShell,rv,ProcessPath,ProcessName
Title = "Launching and killing application using Vbcript"
Set objShell = CreateObject("WScript.Shell")
ProcessPath = "C:\Windows\system32\Calc.exe"
rv = objShell.Run(DblQuote(ProcessPath),1,False)
If rv <> 0 Then
MsgBox "Failed : " & rv
End If
Set objShell = Nothing
WScript.Sleep 12000
ProcessPath = Split(ProcessPath,"\")
ProcessName = ProcessPath(UBound(ProcessPath))
Msgbox "The Process named "& DblQuote(ProcessName) &" is being to be killed now !",_
vbExclamation,Title
Call Kill(ProcessName)
'****************************************************
Sub Kill(ProcessName)
Dim Ws,Command,Execution
Set Ws = CreateObject("Wscript.Shell")
Command = "cmd /c Taskkill /F /IM "& DblQuote(ProcessName) &""
Execution = Ws.Run(Command,0,True)
Set Ws = Nothing
End Sub
'****************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'****************************************************
Try This way :
Set objShell = WScript.CreateObject("WScript.Shell")
rv = objShell.Run(chr(34)&"c:\windows\system32\Mspaint.exe"&chr(34), 1 , False)
If rv <> 0 Then
MsgBox "Failed : " & rv
End If
WScript.Sleep 2000
objShell.Run "taskkill /f /im ""Mspaint.exe"" ",0,False
Set objShell = Nothing
I was able to find the error. I set the current directory to the folder that contains the .exe file.This is the modified script:
Option Explicit
Dim Title,objShell,rv,ProcessPath,ProcessName
Title = "Launching and killing application using Vbcript"
Set objShell = CreateObject("WScript.Shell")
objShell.CurrentDirectory = "path\to\folder\containing\.exe"
ProcessPath = "path\to\application.exe"
objShell.Run DblQuote(ProcessPath),1,False
If rv <> 0 Then
MsgBox "Failed : " & rv
End If
Set objShell = Nothing
WScript.Sleep 12000
ProcessPath = Split(ProcessPath,"\")
ProcessName = ProcessPath(UBound(ProcessPath))
Msgbox "The Process named "& DblQuote(ProcessName) &" is being to be killed now !",_
vbExclamation,Title
Call Kill(ProcessName)
Sub Kill(ProcessName)
Dim Ws,Command,Execution
Set Ws = CreateObject("Wscript.Shell")
Command = "cmd /c Taskkill /F /IM "& DblQuote(ProcessName) &""
Execution = Ws.Run(Command,0,True)
Set Ws = Nothing
End Sub
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
Related
For example:
I have a code of VBS, it will help me check a program is already running
Function isProcessRunning(strComputer, strProcess)
Dim Process, strObject
strObject = "winmgmts://" & strComputer
For Each Process In GetObject(strObject).InstancesOf("Win32_Process")
If UCase(Process.Name) = UCase(strProcess) Then
isProcessRunning = True
Exit Function
Else
isProcessRunning = False
End If
Next
End Function
But, I want to get process is already running for re-using.
Function shell()
If isProcessRunning(".", "cmd.exe") == False Then
Dim objShell
Set objShell = WScript.CreateObject("WScript.Shell")
shell = objShell.Run(cmd)
Else
shell = ... 'how can I get cmd.exe already running here
End If
Next
End Function
Update my problem
Actually, I want to get instance of cmd.exe if it's already running. I mean, I don't want re-open cmd.exe again.
Example:
I have just opened cmd.exe.
I run this code below (its name is laucher.vbs).
Function isProcessRunning(strComputer, strProcess)
Dim Process, strObject
strObject = "winmgmts://" & strComputer
For Each Process In GetObject(strObject).InstancesOf("Win32_Process")
If UCase(Process.Name) = UCase(strProcess) Then
isProcessRunning = True
Exit Function
Else
isProcessRunning = False
End If
Next
End Function
Function getProcessRunning(strComputer, strProcess)
Dim Process, strObject
strObject = "winmgmts://" & strComputer
For Each Process In GetObject(strObject).InstancesOf("Win32_Process")
If UCase(Process.Name) = UCase(strProcess) Then
... 'I do not know how to code this here for return instance of Process is running ...
Exit Function
End If
Next
End Function
Function shell()
If isProcessRunning(".", "cmd.exe") == False Then
Dim objShell
Set objShell = WScript.CreateObject("WScript.Shell")
shellFn = objShell.Run("cmd")
Else
shellFn = getProcessRunning(".", "cmd.exe")
End If
End Function
Dim cmdExe
cmdExe = shell
cmdExe "shutdown -s -t 60"
Because cmd.exe is already running cmdExe "shutdown -s -t 60" will re-using cmd and execute command.
Give a try for this example :
Option Explicit
Dim ProcessPath1,ProcessPath2
ProcessPath1 = "%windir%\system32\cmd.exe"
ProcessPath2 = "%ProgramFiles%\Internet Explorer\iexplore.exe"
Call CheckProcess(ProcessPath1)
Call CheckProcess(ProcessPath2)
'**************************************************************************
Sub CheckProcess(ProcessPath)
Dim strComputer,objWMIService,colProcesses,WshShell,Tab,ProcessName
strComputer = "."
Tab = Split(ProcessPath,"\")
ProcessName = Tab(UBound(Tab))
ProcessName = Replace(ProcessName,Chr(34),"")
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcesses = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = '"& ProcessName & "'")
If colProcesses.Count = 0 Then
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run DblQuote(ProcessPath)
Else
MsgBox DblQuote(ProcessName) & " is aleardy running !", vbExclamation,_
DblQuote(ProcessName) & " is aleardy running !"
Exit Sub
End if
End Sub
'**************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'**************************************************************************
The code I have below runs without error.
But I need it to wait until the process has been killed at this line: WshShell.Exec "TASKKILL /F /IM " & EngineRun.ProcessID before showing the msgbox that it has been terminated.
Option Explicit
Dim WshShell As Object
Dim EngineRun As Object
Sub main()
Set WshShell = CreateObject("WScript.Shell")
Set EngineRun = WshShell.Exec("notepad.exe")
MsgBox EngineRun.ProcessID
WshShell.Exec "TASKKILL /F /IM " & EngineRun.ProcessID
MsgBox EngineRun.ProcessID & (" terminated")
End Sub
Thanks for any help
Could you use the Run method instead? See MSDN. It supports a bWaitOnReturn parameter:
object.Run(strCommand, [intWindowStyle], [bWaitOnReturn])
So your code would look like:
WshShell.Run "TASKKILL /F /IM " & EngineRun.ProcessID,4 , True
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * From Win32_Process")
For Each objItem in colItems
'msgbox objItem.ProcessID & " " & objItem.CommandLine
If objItem.name = "Calculator.exe" then objItem.terminate
Next
Do things properly.
I'm looking for a bit of code to get an HTA to restart from the beginning. I have seen a forum on this site that creates an HTA that calls a .vbs and cyclically restarts, but I'm looking for hopefully a line or 5 or code that will start an HTA from the beginning.
What I could do is have the script re-open the HTA with the shell.run command and then close it, but is there a cleaner way to do this?
Here is a complete example showing how we can use Location.Reload(True) to reload the HTA file
The good password is 9999
<HTML>
<HEAD>
<TITLE></TITLE>
<HTA:APPLICATION
APPLICATIONNAME="Access to the system © Hackoo © 2015"
BORDER="THIN"
BORDERSTYLE="NORMAL"
ICON="Explorer.exe"
INNERBORDER="NO"
MAXIMIZEBUTTON="NO"
MINIMIZEBUTTON="NO"
SCROLL="NO"
SELECTION="NO"
SINGLEINSTANCE="YES"/>
</HEAD>
<META HTTP-EQUIV="MSThemeCompatible" CONTENT="YES">
<BODY TOPMARGIN="1" LEFTMARGIN="1"><CENTER><DIV><SPAN ID="ONSCR"></SPAN></DIV></CENTER></BODY>
<SCRIPT LANGUAGE="VBScript">
Option Explicit
Dim Title,ws,Voice,ErrorMsg,WelcomeMsg,MyGoodPassword,Password,Temp,Tests,ProcessEnv,UserName
Title = "Access to the system © Hackoo 2015"
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject("wscript.Shell")
Set ProcessEnv = Ws.Environment("Process")
UserName = ProcessEnv("USERNAME")
Temp = WS.ExpandEnvironmentStrings("%Temp%")
Tests = Temp &"\Tests.txt"
'------------------------------------------------------------------------------------
Sub window_onload()
CenterWindow 280,180
Call PasswordForm()
Call TextFocus
Dim Count : Count = 0
If Not objFSO.FileExists(Tests) Then
Dim Logfile : Set Logfile = objFSO.OpenTextFile(Tests,2,True)
Logfile.writeline Count
Logfile.Close
end If
Call Kill("Explorer.exe")
Call DisableTaskMgr()
End Sub
'------------------------------------------------------------------------------------
Sub CenterWindow(x,y)
Dim iLeft,itop
window.resizeTo x,y
iLeft = window.screen.availWidth/2 - x/2
itop = window.screen.availHeight/2 - y/2
window.moveTo ileft,itop
End Sub
'------------------------------------------------------------------------------------
Sub PasswordForm()
Self.document.title = "Access to the system © Hackoo 2015"
Self.document.bgColor = "DarkOrange"
ONSCR.InnerHTML="<center><FONT COLOR=""#FFFFFF"" SIZE=""+1"" FACE=""VERDANA,ARIAL,HELVETICA,SANS-SERIF"">Type your Password</FONT><br><br><input type=""password"" name=""PasswordArea"" size=""20"" onKeyUp=""TextFocus""><P>"_
&"<input type=""Submit"" STYLE=""HEIGHT:25;WIDTH:190"" value=""Access to the system"" name=""run_button"" onClick=""CheckPassword"">"
END Sub
'------------------------------------------------------------------------------------
Sub CheckPassword
Dim NB_Tests_MAX : NB_Tests_MAX = 3
Dim Readfile,Count,NB_Tests_Remaining,Logfile,Controle,Command,Executer,MsgNumbTests,MsgReboot
Set Voice = CreateObject("SAPI.SpVoice")
ErrorMsg = "ATTENTION ! ! ! "& vbcr &"The Password is Wrong ! "& vbcr &"Try Again !"
WelcomeMsg = "Welcome again "& DblQuote(UserName) &" in your System !"
MyGoodPassword = "9999"
Set Readfile = objFSO.OpenTextFile(Tests,1)
Count = Readfile.ReadAll
Readfile.Close
Controle = True
While Controle
Count = Count + 1
NB_Tests_Remaining = NB_Tests_MAX - Count
Set Logfile = objFSO.OpenTextFile(Tests,2,True)
Logfile.writeline Count
Logfile.Close
If PasswordArea.Value <> MyGoodPassword Then
Voice.Speak ErrorMsg
ws.Popup ErrorMsg,"1",Title,0+16
MsgNumbTests = "ATTENTION !!! "&vbcr&"Bad Password and NB°of TESTS is " & Count &"."&vbCr&_
"The remaining number of tests is "& NB_Tests_Remaining
Voice.Speak MsgNumbTests
MsgBox MsgNumbTests,48,Title
Sleep(1)
Location.Reload(True)
end if
If PasswordArea.Value = MyGoodPassword Then
If objFSO.FileExists(Tests) Then objFSO.DeleteFile Tests,True
Controle = False
Voice.Speak WelcomeMsg
ws.Popup WelcomeMsg,"1",Title,0+64
Call Launch("Explorer.exe")
Call EnableTaskMgr()
Self.Close
Exit Sub
End If
If Count = NB_Tests_MAX Then
If objFSO.FileExists(Tests) Then objFSO.DeleteFile Tests,True
Voice.Speak "The computer will reboot in 30 seconds !"
MsgReboot = "The Limit number of tests is reached ! "&vbcr& "The computer will Reboot in 30 seconds !"
MsgBox MsgReboot,48,"The Limit number of tests is reached ! "
Command="cmd /c Shutdown.exe -r -t 30 -c " & chr(34) & "The computer will reboot in 30 seconds !" & chr(34)
Executer = WS.Run(Command,0,False)
window.close
End If
Exit Sub
wend
End Sub
'----------------------------------------------------------------------------------
Sub TextFocus
PasswordArea.Focus
End Sub
'----------------------------------------------------------------------------------
Sub Kill(Process)
Dim Ws,Command,Execution
Set Ws = CreateObject("Wscript.Shell")
Command = "cmd /c Taskkill /F /IM "&Process&""
Execution = Ws.Run(Command,0,False)
End Sub
'----------------------------------------------------------------------------------
Sub Launch(Process)
Dim Ws,Command,Execution
Set Ws = CreateObject("Wscript.Shell")
Command = "cmd /c Start "&Process&""
Execution = Ws.Run(Command,0,False)
End Sub
'-----------------------------------------------------------------------------------
'------------------------------EnableTaskMgr----------------------------------------
Sub EnableTaskMgr()
Dim WshShell,System
System="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System\"
Set WshShell=CreateObject("WScript.Shell")
Wshshell.RegWrite System, "REG_SZ"
WshShell.RegWrite System &"\DisableTaskMgr", 0, "REG_DWORD"
End sub
'------------------------------------------------------------------------------------
'-----------------------------DisableTaskMgr-----------------------------------------
Sub DisableTaskMgr()
Dim WshShell,System
System="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System\"
Set WshShell=CreateObject("WScript.Shell")
Wshshell.RegWrite System, "REG_SZ"
WshShell.RegWrite System &"\DisableTaskMgr", 1, "REG_DWORD"
End sub
'--------------------------------------------------------------------------------------
Sub Sleep(intNumSecs)
' Because WScript.Sleep () is not available in HTA
' scripts, invoke a VBScript file to do the waiting.
Dim strScriptFile, strCommand, intRetcode, objWS
If intNumSecs <= 0 Then Exit Sub
Set objWS = CreateObject ("WScript.Shell")
strScriptFile = "%temp%\wait" & intNumSecs & "seconds.vbs"
strCommand = "cmd /c ""echo WScript.Sleep " & intNumSecs * 1000 & " >" & strScriptFile & _
"&start /wait """" wscript.exe " & strScriptFile & """"
intRetCode = objWS.Run (strCommand, 0, True)
If intRetCode = 0 Then Exit Sub
End Sub
'---------------------------------------------------------------------------------------
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'---------------------------------------------------------------------------------------
</SCRIPT>
In referring to a comment by #MCND, to restart a script, simply implement
location.reload True
After whatever event you want to use
I have a message box that repeats itself whenever you click ok- which is the only option, by the way.
My code:
'Very Annoying script'
Set objShell = CreateObject("Wscript.Shell")
intMessage = Msgbox("Click ok to say yes",16, "Is this messagebox annoying?")
If intMessage = vbOK Then
RETRY
Else
Wscript.Quit
End If
SUB RETRY
'Very Annoying script'
Set objShell = CreateObject("Wscript.Shell")
intMessage = Msgbox("Click ok to say yes",16, "Is this messagebox annoying?")
If intMessage = vbOK Then
RETRY
Else
Wscript.Quit
End If
End sub
Can I end the following script without ending the process labeled Micorosft Windows based Script Host'?
That includes not running the cmd line (It won't work)
taskkill /im wscript.exe
OR
going to the task manager.
The only way to do end the script is to use
taskkill /f /im wscript.exe
Other then that, it will simply re-run the script (the same effect as when you just simply click ok)
Thank you to Jiang YD for answering
If you use this command taskkill /IM wscript.exe /F ; You kill all the running vbscript, but
If you have a lot of a running script in loop with differents paths, you can use this vbscript to choose which one to be killed or not .So the aim of this script is to select and focus to the process that you want to be killed and you can also save it in a log file.
Just give a try ;)
Option Explicit
Dim Titre,Copyright,fso,ws,NomFichierLog,temp,PathNomFichierLog,OutPut,Count,strComputer
If AppPrevInstance() Then
MsgBox "Il y a une instance déjà en cours" & VbCrLF & CommandLineLike(WScript.ScriptName),VbExclamation,"Il y a une instance déjà en cours"
WScript.Quit
Else
Copyright = "[© Hackoo © 2015 ]"
Set fso = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject( "Wscript.Shell" )
NomFichierLog="Killed Process.txt"
temp = ws.ExpandEnvironmentStrings("%temp%")
PathNomFichierLog = temp & "\" & NomFichierLog
Set OutPut = fso.CreateTextFile(temp & "\" & NomFichierLog,1)
strComputer = "."
Call Find("wscript.exe")
Call Explorer(PathNomFichierLog)
End If
'***************************************************************************************************
Function Explorer(File)
Dim ws
Set ws = CreateObject("wscript.shell")
ws.run "Explorer "& File & "\",1,True
end Function
'***************************************************************************************************
Sub Find(MyProcess)
Dim colItems,objItem,Processus,Question
Titre = " Processus "& DblQuote(MyProcess) &" en cours d'exécution "
Set colItems = GetObject("winmgmts:").ExecQuery("Select * from Win32_Process " _
& "Where Name like '%"& MyProcess &"%' AND NOT commandline like " & CommandLineLike(WScript.ScriptFullName) & "",,48)
Count = 0
For Each objItem in colItems
Count= Count + 1
'Processus = Mid(objItem.CommandLine,InStr(objItem.CommandLine,""" """) + 2) 'Extraction du chemin du script en ligne de commande
Processus = objItem.CommandLine 'Replace(Processus,chr(34),"")
Question = MsgBox ("Voulez-vous arrêter ce script : " & DblQuote(Processus) & " ?" ,VBYesNO+VbQuestion,Titre+Copyright)
If Question = VbYes then
objItem.Terminate(0)'Tuer ce processus
OutPut.WriteLine Processus
else
Count= Count - 1 'décrementer le compteur de -1
End if
Next
OutPut.WriteLine String(100,"*")
OutPut.WriteLine count & Titre & "ont été arrêtés"
OutPut.WriteLine String(100,"*") & VbCrLF
End Sub
'**************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'**************************************************************************
Function AppPrevInstance()
With GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
With .ExecQuery("SELECT * FROM Win32_Process WHERE CommandLine LIKE " & CommandLineLike(WScript.ScriptFullName) & _
" AND CommandLine LIKE '%WScript%' OR CommandLine LIKE '%cscript%'")
AppPrevInstance = (.Count > 1)
End With
End With
End Function
'**************************************************************************
Sub Pause(Minutes)
Wscript.Sleep(Minutes*1000*60)
End Sub
'**************************************************************************
Function StripProcPath(ProcessPath)
Dim arrStr : arrStr = Split(ProcessPath, "\")
StripProcPath = arrStr(UBound(arrStr))
End Function
'**************************************************************************
Function CommandLineLike(ProcessPath)
ProcessPath = Replace(ProcessPath, "\", "\\")
CommandLineLike = "'%" & ProcessPath & "%'"
End Function
'**************************************************************************
I was hoping someone would be able to proved me some direction. I would like to set an application launcher I have created to require a password to be closed. Thank you for any assistance you are able to offer.
But here is some incomplete code to show you my purpose.
Set objShell = CreateObject("Wscript.Shell")
dim password
password=InputBox("Please Enter Password:","3 - Tries Left")
if password = ("9999") then
dim correct correct =MsgBox("Correct Password!",64,"correct")
objShell.Run("shutdown /m shutdown -r -f -t 0")
Else
dim again
again =MsgBox("Incorrect Password! Do You Want To Try Again?",53,"Incorrect Password!")
If again = 4 Then
dim password2
password2=InputBox("Please Enter Password:","2 - Tries Left")
if password2 = ("9999") then
dim correct2
correct2 =MsgBox("Correct Password!",64,"correct")
Sorry ! I was unable to post all of the code.I just need to know what to put to close the existing window. I think telling it to close MSHTA.EXE will work.
Try this HTA and i hope that can did the trick.
NB : The Password is 9999 and of course you can change it at this line
MyGoodPassword = "9999"
<HTML>
<HEAD>
<TITLE></TITLE>
<HTA:APPLICATION
APPLICATIONNAME="Access to the system © Hackoo © 2015"
BORDER="THIN"
BORDERSTYLE="NORMAL"
ICON="Explorer.exe"
INNERBORDER="NO"
MAXIMIZEBUTTON="NO"
MINIMIZEBUTTON="NO"
SCROLL="NO"
SELECTION="NO"
SINGLEINSTANCE="YES"/>
</HEAD>
<META HTTP-EQUIV="MSThemeCompatible" CONTENT="YES">
<BODY TOPMARGIN="1" LEFTMARGIN="1"><CENTER><DIV><SPAN ID="ONSCR"></SPAN></DIV></CENTER></BODY>
<SCRIPT LANGUAGE="VBScript">
Option Explicit
Dim Title,ws,Voice,ErrorMsg,WelcomeMsg,MyGoodPassword,Password,Temp,Tests,ProcessEnv,UserName
Title = "Access to the system © Hackoo 2015"
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject("wscript.Shell")
Set ProcessEnv = Ws.Environment("Process")
UserName = ProcessEnv("USERNAME")
Temp = WS.ExpandEnvironmentStrings("%Temp%")
Tests = Temp &"\Tests.txt"
'------------------------------------------------------------------------------------
Sub window_onload()
CenterWindow 280,180
Call PasswordForm()
Call TextFocus
Dim Count : Count = 0
If Not objFSO.FileExists(Tests) Then
Dim Logfile : Set Logfile = objFSO.OpenTextFile(Tests,2,True)
Logfile.writeline Count
Logfile.Close
end If
Call Kill("Explorer.exe")
Call DisableTaskMgr()
End Sub
'------------------------------------------------------------------------------------
Sub CenterWindow(x,y)
Dim iLeft,itop
window.resizeTo x,y
iLeft = window.screen.availWidth/2 - x/2
itop = window.screen.availHeight/2 - y/2
window.moveTo ileft,itop
End Sub
'------------------------------------------------------------------------------------
Sub PasswordForm()
Self.document.title = "Access to the system © Hackoo 2015"
Self.document.bgColor = "DarkOrange"
ONSCR.InnerHTML="<center><FONT COLOR=""#FFFFFF"" SIZE=""+1"" FACE=""VERDANA,ARIAL,HELVETICA,SANS-SERIF"">Type your Password</FONT><br><br><input type=""password"" name=""PasswordArea"" size=""20"" onKeyUp=""TextFocus""><P>"_
&"<input type=""Submit"" STYLE=""HEIGHT:25;WIDTH:190"" value=""Access to the system"" name=""run_button"" onClick=""CheckPassword"">"
END Sub
'------------------------------------------------------------------------------------
Sub CheckPassword
Dim NB_Tests_MAX : NB_Tests_MAX = 3
Dim Readfile,Count,NB_Tests_Remaining,Logfile,Controle,Command,Executer,MsgNumbTests,MsgReboot
Set Voice = CreateObject("SAPI.SpVoice")
ErrorMsg = "ATTENTION ! ! ! "& vbcr &"The Password is Wrong ! "& vbcr &"Try Again !"
WelcomeMsg = "Welcome again "& DblQuote(UserName) &" in your System !"
MyGoodPassword = "9999"
Set Readfile = objFSO.OpenTextFile(Tests,1)
Count = Readfile.ReadAll
Readfile.Close
Controle = True
While Controle
Count = Count + 1
NB_Tests_Remaining = NB_Tests_MAX - Count
Set Logfile = objFSO.OpenTextFile(Tests,2,True)
Logfile.writeline Count
Logfile.Close
If PasswordArea.Value <> MyGoodPassword Then
Voice.Speak ErrorMsg
ws.Popup ErrorMsg,"1",Title,0+16
MsgNumbTests = "ATTENTION !!! "&vbcr&"Bad Password and NB°of TESTS is " & Count &"."&vbCr&_
"The remaining number of tests is "& NB_Tests_Remaining
Voice.Speak MsgNumbTests
MsgBox MsgNumbTests,48,Title
Sleep(1)
Location.Reload(True)
end if
If PasswordArea.Value = MyGoodPassword Then
If objFSO.FileExists(Tests) Then objFSO.DeleteFile Tests,True
Controle = False
Voice.Speak WelcomeMsg
ws.Popup WelcomeMsg,"1",Title,0+64
Call Launch("Explorer.exe")
Call EnableTaskMgr()
Self.Close
Exit Sub
End If
If Count = NB_Tests_MAX Then
If objFSO.FileExists(Tests) Then objFSO.DeleteFile Tests,True
Voice.Speak "The computer will reboot in 30 seconds !"
MsgReboot = "The Limit number of tests is reached ! "&vbcr& "The computer will Reboot in 30 seconds !"
MsgBox MsgReboot,48,"The Limit number of tests is reached ! "
Command="cmd /c Shutdown.exe -r -t 30 -c " & chr(34) & "The computer will reboot in 30 seconds !" & chr(34)
Executer = WS.Run(Command,0,False)
window.close
End If
Exit Sub
wend
End Sub
'----------------------------------------------------------------------------------
Sub TextFocus
PasswordArea.Focus
End Sub
'----------------------------------------------------------------------------------
Sub Kill(Process)
Dim Ws,Command,Execution
Set Ws = CreateObject("Wscript.Shell")
Command = "cmd /c Taskkill /F /IM "&Process&""
Execution = Ws.Run(Command,0,False)
End Sub
'----------------------------------------------------------------------------------
Sub Launch(Process)
Dim Ws,Command,Execution
Set Ws = CreateObject("Wscript.Shell")
Command = "cmd /c Start "&Process&""
Execution = Ws.Run(Command,0,False)
End Sub
'-----------------------------------------------------------------------------------
'------------------------------EnableTaskMgr----------------------------------------
Sub EnableTaskMgr()
Dim WshShell,System
System="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System\"
Set WshShell=CreateObject("WScript.Shell")
Wshshell.RegWrite System, "REG_SZ"
WshShell.RegWrite System &"\DisableTaskMgr", 0, "REG_DWORD"
End sub
'------------------------------------------------------------------------------------
'-----------------------------DisableTaskMgr-----------------------------------------
Sub DisableTaskMgr()
Dim WshShell,System
System="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System\"
Set WshShell=CreateObject("WScript.Shell")
Wshshell.RegWrite System, "REG_SZ"
WshShell.RegWrite System &"\DisableTaskMgr", 1, "REG_DWORD"
End sub
'--------------------------------------------------------------------------------------
Sub Sleep(intNumSecs)
' Because WScript.Sleep () is not available in HTA
' scripts, invoke a VBScript file to do the waiting.
Dim strScriptFile, strCommand, intRetcode, objWS
If intNumSecs <= 0 Then Exit Sub
Set objWS = CreateObject ("WScript.Shell")
strScriptFile = "%temp%\wait" & intNumSecs & "seconds.vbs"
strCommand = "cmd /c ""echo WScript.Sleep " & intNumSecs * 1000 & " >" & strScriptFile & _
"&start /wait """" wscript.exe " & strScriptFile & """"
intRetCode = objWS.Run (strCommand, 0, True)
If intRetCode = 0 Then Exit Sub
End Sub
'---------------------------------------------------------------------------------------
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'---------------------------------------------------------------------------------------
</SCRIPT>