How to read something from Command prompt using Vbscript ?
For example :
If I run date /T command it will return current system date.
So how to read the output date ?
Thanks !
Something like that :
Msgbox RunDos("Date /T")
'******************************************************************************************
Function RunDos(strCommand)
Dim wsh, fs, ts
Dim strTempFile, strData
Const ForReading = 1
Const TemporaryFolder = 2
Const WshHide = 0
Set wsh = CreateObject("Wscript.Shell")
Set fs = CreateObject("Scripting.FileSystemObject")
strTempFile = fs.BuildPath(fs.GetSpecialFolder(TemporaryFolder).Path, fs.GetTempName)
wsh.Run "cmd.exe /c " & strCommand & " > """ & strTempFile & """", WshHide, True
Set ts = fs.OpenTextFile(strTempFile, ForReading, True)
strData = ts.ReadAll
RunDos = strData
ts.Close
End Function
'******************************************************************************************
EDIT : Adding another code with inputbox
Option Explicit
Dim Mycmd
Mycmd = InputBox("Type a command line to be executed ! "& vbcr &"For example Ping www.google.com",_
"Type a command line to be executed !","Ping www.google.com")
If Mycmd = "" Then Wscript.Quit
wscript.echo Run_Cmd(Mycmd)
'**********************************************************************************************
Function Run_Cmd(strCommand)
Const ForReading = 1
Const TemporaryFolder = 2
Const WshHide = 0
Dim wsh, fs, ts
Dim strTempFile,strFile, strData
Set wsh = CreateObject("Wscript.Shell")
Set fs = CreateObject("Scripting.FileSystemObject")
strTempFile = fs.BuildPath(fs.GetSpecialFolder(TemporaryFolder).Path, fs.GetTempName)
strFile = fs.BuildPath(fs.GetSpecialFolder(TemporaryFolder).Path, "result.txt")
wsh.Run "cmd.exe /c " & strCommand & " > " & DblQuote(strTempFile) & "2>&1", WshHide, True
wsh.Run "cmd.exe /u /c Type " & DblQuote(strTempFile) & " > " & DblQuote(strFile) & "", WshHide, True
Set ts = fs.OpenTextFile(strFile, ForReading,true,-1)
strData = ts.ReadAll
Run_Cmd = strData
ts.Close
fs.DeleteFile strTempFile
fs.DeleteFile strFile
End Function
'**********************************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************
And this another one showing you how to execute a command line with a HTA file : CommandLine.hta
<html>
<title>Execution of command line with HTA by Hackoo</title>
<head>
<HTA:APPLICATION
APPLICATIONNAME="Execution of command line with HTA by Hackoo"
SCROLL="no"
SINGLEINSTANCE="yes"
WINDOWSTATE="maximize"
ICON="Winver.exe"
/>
</head>
<META HTTP-EQUIV="MSThemeCompatible" CONTENT="YES">
<script language="VBScript">
Option Explicit
Dim Title : Title = "Execution of command line with HTA by Hackoo"
'**********************************************************************************************
Sub Window_OnLoad
Call Run_Cmd("help")
End Sub
'**********************************************************************************************
Sub Run_Cmd(strCommand)
On Error Resume Next
If input.value = "" Then
MsgBox "ATTENTION ! The text box is empty !"& vbcr &_
"You forgot to type a command on the text box !",vbExclamation,Title
Exit Sub
End if
Output.value = ""
btnClick.disabled = True
document.body.style.cursor = "wait"
btnClick.style.cursor = "wait"
Const ForReading = 1
Const TristateTrue = -1
Const TemporaryFolder = 2
Const WshHide = 0
Dim wsh, fs, ts
Dim strTempFile,strFile, strData
Set wsh = CreateObject("Wscript.Shell")
Set fs = CreateObject("Scripting.FileSystemObject")
strTempFile = fs.BuildPath(fs.GetSpecialFolder(TemporaryFolder).Path, fs.GetTempName)
strFile = fs.BuildPath(fs.GetSpecialFolder(TemporaryFolder).Path, "result.txt")
wsh.Run "cmd.exe /c " & strCommand & " > " & DblQuote(strTempFile) & "2>&1", WshHide, True
wsh.Run "cmd.exe /u /c Type " & DblQuote(strTempFile) & " > " & DblQuote(strFile) & "", WshHide, True
Set ts = fs.OpenTextFile(strFile,ForReading,True,TristateTrue)
strData = ts.ReadAll
Output.Value = "Microsoft Windows [version 7.1 7631]" & vbcrlf &_
"Copyright (c) 2009 Microsoft Corporation. All rights reserved." & vbcrlf & vbcrlf &_
"C:\>"& strCommand & vbcrlf & strData
ts.Close
fs.DeleteFile strTempFile
fs.DeleteFile strFile
document.body.style.cursor = "default"
btnClick.style.cursor = "default"
btnClick.disabled = False
End Sub
'**********************************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************
Sub OnClickButtonCopy()
document.parentwindow.clipboardData.SetData "text", Output.Value
MsgBox "The ouput result is copied to the clipboard !",vbInformation,Title
End Sub
'**********************************************************************************************
</script>
</head>
<body bgcolor="123456" text=darkorange>
<hr>
<center><FONT SIZE="3"><B><I>Some examples of commands</I></B></FONT><BR>
<select style="background-color:lightblue" name="DropDown">
<option value="CD %Programfiles%\Mozilla Firefox\ | Start Firefox.exe">CD %Programfiles%\Mozilla Firefox\ | Start Firefox.exe</option>
<option value="Tracert www.google.fr">Tracert www.google.fr</option>
<option value="Start iexplore">Start iexplore</option>
<option value="Start Notepad">Start Notepad</option>
<option value="Start Winword">Start Winword</option>
<option value="Explorer.exe /n,/e,/root,C:\Program Files">Explorer.exe /n,/e,/root,C:\Program Files</option>
<option value="Ipconfig">IpConfig</option>
<option value="Dir">Dir</option>
<option value="Ping www.yahoo.fr">Ping www.yahoo.fr</option>
<option value="Ping www.google.fr">Ping www.google.fr</option>
</select>
<input type="button" onClick="Run_Cmd(DropDown.value)" value="Run this command">
<center><hr><B><I>Type your input command here</I></B><br>
<input type="text" Name="input" size="10"style="width:100%" value="Ping www.google.com" style="background-color:lightblue">
<input type="submit" name="btnClick" value="Run the input command line" onclick="Run_Cmd(input.value)">
<br><hr><B><I> The output result (readonly)</I></B><hr>
<textarea readonly id="Output" style="width:100%" rows="28" style="background-color:black; color:white">Microsoft Windows [version 7.1 7631]
Copyright (c) 2009 Microsoft Corporation. All rights reserved.
C:\></textarea><input type="button" name="ButtonCopy" value="Copy the ouput result to the Clipboard" onclick="OnClickButtonCopy">
<hr></center>
</body>
</html>
Screenshot of CommandLine.hta
You can use the WshScriptExec object obtained from %comspec% /c date /T:
>> WScript.Echo CreateObject("WScript.Shell").Exec("%comspec% /c date /T").Stdout.ReadAll()
>>
10.02.2016
but a simple
>> WScript.Echo Date()
>>
10.02.2016
is less risky.
Related
I am running this command remotely in a VBS script file. The problem I am having is that it generates a CMD window momentarily and it distracts some users. How can I run this without generating the CMD window? Preferably, I want to get the WMI data in native VBS language without using oShell.run? I rather not use CMD. Thanks.
oShell.run "cmd /c wmic logicaldisk get name,providername,description,volumename,filesystem /format:list > c:\users\%username%\drives.txt"
Or you could just use what you've already got and pass the 'hidden window' parameter to the Run command (see the second parameter of 0 below):
Dim objShell : Set objShell = WScript.CreateObject("WScript.Shell")
objShell.Run "cmd /c wmic logicaldisk get name,providername,description,volumename,filesystem /format:list > c:\users\%username%\drives.txt", 0, true
Set objShell = Nothing
You can give a try for this code in pure vbscript :
Option Explicit
Dim Ws,ReportFile,strHomeFolder
Set Ws = CreateObject("WScript.Shell")
strHomeFolder = Ws.ExpandEnvironmentStrings("%USERPROFILE%")
ReportFile = strHomeFolder & "\drives.txt"
'MsgBox GetDrives_Information
Call WriteReport(GetDrives_Information,ReportFile)
'-------------------------------------------------------
Function GetDrives_Information()
Dim oFSO,report,objWMIService,objLogicalDisk
Set oFSO = CreateObject("Scripting.FileSystemObject")
Dim oDrives
Set oDrives = oFSO.Drives
Dim oDrive
Dim strLectType
on error resume next
For Each oDrive in oDrives
If oDrive.IsReady Then
Select Case oDrive.DriveType
Case 0: strLectType = "Unknown"
Case 1: strLectType = "Amovible (USB)"
Case 2: strLectType = "Fixe (Hard Drive)"
Case 3: strLectType = "Network"
Case 4: strLectType = "CD-Rom"
Case 5: strLectType = "Virtuel"
End Select
report = report & "- Drive letter: " & oDrive.DriveLetter & vbCrLf
report = report & "- serial number: " & oDrive.SerialNumber & vbCrLf
report = report & "- Drive Type: " & oDrive.strLectType & vbCrLf
If (oDrive.FileSystem <> "") Then
report = report & "- File system used : " & oDrive.FileSystem & vbCrLf
End If
Set objWMIService = GetObject("winmgmts:")
Set objLogicalDisk = objWMIService.Get("Win32_LogicalDisk.DeviceID='" & oDrive.DriveLetter & ":'")
report = report & "- There is " & objLogicalDisk.FreeSpace /1024\1024+1 & " Mo remaining space on this drive / disk" & vbCrLf
report = report & "- There is " & objLogicalDisk.Size /1024\1024+1 & " Mo total space on this drive / disk" & vbCrLf
End If
report = report & vbCrLf
Next
GetDrives_Information = report
End Function
'-------------------------------------------------------
Sub WriteReport(strText,ReportFile)
Dim fs,ts
Const ForWriting = 2
Set fs = CreateObject("Scripting.FileSystemObject")
Set ts = fs.OpenTextFile(ReportFile,ForWriting,True)
ts.WriteLine strText
ts.Close
End Sub
'------------------------------------------------------
I am having trouble displaying a log file in the TextArea of a HTA while a robocopy script is running.
The script is simple enough, the user has one button to press to start the process, selects where they want to back up their data to, a Robocopy runs in the background and logs the work.
I cannot get the .log file to display live during the process and am always hit with an error 800A01B6.
Code below:
<html>
<head>
<title>Backup Script</title>
<HTA:APPLICATION
ID="Backup Script"
APPLICATIONNAME="Backup Script"
BORDER="thin"
SCROLL="no"
SINGLEINSTANCE="yes"
WINDOWSTATE="normal"
>
</head>
<SCRIPT Language="VBScript">
Sub Window_OnLoad
intWidth = 800
intHeight = 800
Me.ResizeTo intWidth, intHeight
Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))
End Sub
Sub run_Backup_Script
Set WshShell = CreateObject("WScript.Shell")
Set WshNetwork = CreateObject("WScript.Network")
Dim NetSharedFolder, TargetLocalFolder, Settings
'Delete Log File bigger than 10MB
Set oFSO = CreateObject("Scripting.FileSystemObject")
If oFSO.FileExists("D:\Public\Backup.log") Then
Set file = oFSO.GetFile("D:\Public\Backup.log")
if file.Size >= 10485760 Then
oFSO.DeleteFile("D:\Public\Backup.log")
End If
End If
'Set Settings
Settings = " /MIR /FFT /R:3 /LOG+:D:\Public\Backup.log"
NetSharedFolder = "D:\LocalData\" & WshNetwork.UserName
'Select Target Folder
TargetLocalFolder = BrowseFolder( "Desktop", True , "Select a destination folder")
'Backup starts
objExecute = "RoboCopy.exe " & chr(34) & NetSharedFolder & chr(34) & " " & Chr(34) & TargetLocalFolder & chr(34) & " " & Settings & chr(34)
WshShell.Run objExecute, 0, True
DisplayOutput "D:\Public\Backup.log"
End Sub
'------------------------------------------------------------------------
Sub DisplayOutput(strFileName)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strFileName, 1, False)
BasicTextArea.Text = BasicTextArea.Text & VbCrLf & objFile.ReadAll
objFile.Close
End Sub
'------------------------------------------------------------------------
Function BrowseFolder( myStartLocation, blnSimpleDialog, myMessage )
Const MY_COMPUTER = &H11&
Const WINDOW_HANDLE = 0 ' Must ALWAYS be 0
Dim numOptions, objFolder, objFolderItem
Dim objPath, objShell, strPath, strPrompt
' Set the options for the dialog window
strPrompt = myMessage
If blnSimpleDialog = True Then
numOptions = 0 ' Simple dialog
Else
numOptions = &H10& ' Additional text field to type folder path
End If
' Create a Windows Shell object
Set objShell = CreateObject( "Shell.Application" )
' If specified, convert "My Computer" to a valid
' path for the Windows Shell's BrowseFolder method
If UCase( myStartLocation ) = "MY COMPUTER" Then
Set objFolder = objShell.Namespace( MY_COMPUTER )
Set objFolderItem = objFolder.Self
strPath = objFolderItem.Path
Else
strPath = myStartLocation
End If
Set objFolder = objShell.BrowseForFolder( WINDOW_HANDLE, strPrompt, _
numOptions, strPath )
' Quit if no folder was selected
If objFolder Is Nothing Then
BrowseFolder = ""
Exit Function
End If
' Retrieve the path of the selected folder
Set objFolderItem = objFolder.Self
objPath = objFolderItem.Path
' Return the path of the selected folder
BrowseFolder = objPath
End Function
</SCRIPT>
'------------------------------------------------------------------------
<body STYLE="font:14 pt arial; color:white;filter:progid:DXImageTransform.Microsoft.Gradient
(GradientType=1, StartColorStr='#000033', EndColorStr='#0000FF')" onkeypress='vbs:Default_Buttons'>
<table width='90%' height = '50%' align='center' border='0'>
<tr>
<td align='center' colspan="4">
<h3>Backup Script</h3><br>
</td>
</tr
<tr>
<td align='center' colspan="2">
<table border="1">
<tr>
<td>
<input id="bt_Backup" type="button" value="Run Now" name="Run Now" onClick="vbs:run_Backup_Script">
</td>
</tr>
</table>
</body>
</br></br>
<textarea id="BasicTextArea" name="BasicTextArea" rows="5" cols="75"></textarea>
</html>
Can anyone see where I am going wrong?
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>