VBScript WSHell.Run Multiple Processes - vbscript

Does anyone know how I can accomplish the following:
I have a script that will run and get all users from AD with a homedir assigned and reset the permissions on this folder and everything under it. The problem is, it takes a very long time to complete and if I don't set the .run variable for Wait on return to true, I end up with thousands of cacls processes running. I want to limit the number of processes to say 50, and once one process finishes, move on to the next user. The script is really simple:
' Get Users Home Directories from AD
' Then grant Administrators FULL CONTROL and the USER MODIFY ONLY
'
Set WshShell = WScript.CreateObject("WScript.Shell")
'
' Get users with home directories
WScript.Echo "Retrieving user account names and home directories from active directory. . ."
Set objWMIService = GetObject("winmgmts:root\directory\ldap")
Set colItems = objWMIService.ExecQuery("Select ds_sAMAccountName, ds_homeDirectory From ds_user WHERE ds_homeDirectory IS NOT NULL")
WScript.Echo ""
' Loop through users setting permissions
For Each oUser in colItems
WScript.Echo "Setting permissions for " & oUser.ds_sAMAccountName & " Directory " & oUser.ds_homeDirectory
WshShell.Run "xcacls " & oUser.ds_homeDirectory & " /y /t /g Administrators:F", 0, True
WshShell.Run "xcacls " & oUser.ds_homeDirectory & " /e /t /g " & oUser.ds_sAMAccountName & ":C", 0, True
Next
Does anyone have any idea how I can do this?
Thanks
Edit::::
I think i got it figured out...
For Each oUser in colItems
numrunning = HowMany
while numrunning > 25
WScript.Echo "Waiting for other processes to finish"
WScript.Sleep 10000
numrunning = HowManyRunning
wend
WScript.Echo "Setting permissions for " & oUser.ds_sAMAccountName & " Directory " & oUser.ds_homeDirectory
WshShell.Run "xcacls " & oUser.ds_homeDirectory & " /y /t /g Administrators:F", 0, False
WshShell.Run "xcacls " & oUser.ds_homeDirectory & " /e /t /g " & oUser.ds_sAMAccountName & ":C", 0, False
Next
Function HowManyRunning()
Dim Proc1,Proc2,Proc3
Set Proc1 = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set Proc2 = Proc1.ExecQuery("select * from win32_process" )
HowMany=0
For Each Proc3 in Proc2
If LCase(Proc3.Caption) = "xcacls.exe" Then
HowMany=HowMany + 1
End If
Next
End Function

Related

VBScript and PSExec

Hi I m having problems reading the output provided by WScript.Shell and PSExec. My goal is to be able to read what PSExec.exe returns as text so I can perform some validation with InStr.
The Code is similar to this:
Const WshFinished = 1
Const WshFailed = 2
Dim cmdLine, strComputer
strComputer = "\\SomeComputer"
cmdLine = "psexec " & strComputer & " cmd /C " & """RD " & """%PROGRAMFILES%\APPFOLDER""" & " /S /Q | RD " & """%PROGRAMFILES%\COMMON FILES\APPFOLDER""" & " /S /Q | RD " & """%SYSTEMROOT%\temp\APPFOLDER""" & " /S /Q"""
Set WSH = WScript.CreateObject("WScript.Shell")
WSH.Exec(cmdLine)
Do While WSH.Status = 0
WScript.Sleep 100
Loop
Select Case WSH.Status
Case WshFinished
strOutput = WSH.StdOut.ReadAll
Case WshFailed
strOutput = WSH.StdErr.ReadAll
End Select
Wscript.Echo strOutput
If (InStr(strOutput, "validation text") > 0) Then
'Do Stuff
End IF
The Problem is that strOutput variable comes always empty and I can't perform text validation using - If (InStr(strOutput, "validation text") > 0)
Any Ideas?
Have you considered sending the output from psexec to an output file and then reading the output file from your vbscript?
psexec \\remotemachine command.exe >C:\temp\output.txt 2>&1
will execute command.exe and send output from stdOut and stdErr directly into the file output.txt in C:\temp. You can amend this for your own command.

Popup to appear and close with a target process

I am trying to use the code located here, and with some tweaking for HTA. It works to a point:
Set wshShell = WScript.CreateObject( "WScript.Shell" )
changes into:
Set wshShell = CreateObject( "WScript.Shell" )
The popup comes up, but it won't go away until I click it. I need it appear when a process is running, then disappear when it ends. Why is my execution failing to do this?
ProgressMsg "Copying, Please wait.", "File Being Copied"
strCMD = "cmd.exe /c robocopy " & strLocalSemesterCourse & " " & strServerSemesterCourse &" " & strFileName & " /LOG+:" & strLogName & " /V /FP /TEE"
nReturn = objShell.Run(strCMD, 1, true)
ProgressMsg "", "Finished"
You need to define objProgressMsg as a global variable for this to work:
Dim objProgressMsg
...
ProgressMsg "Copying, Please wait.", "File Being Copied"
strCMD = "cmd.exe /c robocopy " & strLocalSemesterCourse & " " _
& strServerSemesterCourse &" " & strFileName & " /LOG+:" & strLogName _
& " /V /FP /TEE"
nReturn = objShell.Run(strCMD, 1, true)
ProgressMsg "", "Finished"
Without the global variable, ProgressMsg() will use a local variable objProgressMsg. Local variables don't retain their value after the function exits, so the variable will be empty every time you call the function.

How to skip open folders (and skip open files) when moving items using VBScript?

I made a VBscript to move Windows folders, and the script gets stuck when it reaches a folder that a user has open. Is there a way I can change my script so that it skips open folders and skips open files?
Dim fso, directory, item, group, dateStamp, NumberFilesDeleted, text, MoveFoldersErrorInfo, MoveFilesErrorInfo, objLogFile
On error resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
'Move folders in the temp folder to To_Be_Deleted folder and check for errors
fso.MoveFolder "E:\Projects\temp\*" , "E:\Projects\To_Be_Deleted"
If Err.Number <> 0 Then
MoveFoldersErrorInfo = "Error: " & Err.Number & " Error (Hex): " & Hex(Err.Number) & Err.Source & " Description: " & Err.Description
Err.Clear
End If
'Move files in the temp folder to To_Be_Deleted folder and check for errors
fso.MoveFile "E:\Projects\temp\*" , "E:\Projects\To_Be_Deleted"
If Err.Number <> 0 Then
MoveFilesErrorInfo = "Error: " & Err.Number & " Error (Hex): " & Hex(Err.Number) & Err.Source & " Description: " & Err.Description
Err.Clear
End If
Vbscript is extremely slow with fileoperations and if there was a reliable way to check if a file is open it would even further slow down the process. You could just neglect the open files, with "on error resume next" as you do in your scriptsample.
I know of only one reason why you would wanna check and that is forcing the closing of the file with a utility like psfile.exe from systernals but i suppose your users wouldn't be happy with that.
As an external program psfile can be run from your script and check and if desired close open files, so you could run it first on the handled folder with the /c parameter (force close) and then do the move from batch of script.
VBScript is not very reliable in move/delete operations with files. Use DOS commands instead, it will delete/move files even open by users.
You will have to create folders yourself, that is a minus. But it is guaranteed to work and will not give you error messages.
Your code could look similar to this:
Set wshShell = CreateObject( "WScript.Shell" )
wshShell.Run "cmd /c mkdir " & strNewDestination & "\" & strFolder, 0, True
wshShell.Run "cmd /c copy /y " & strFolder & "\*.* " & strNewDestination & "\" & strFolder, 0, True
wshShell.Run "cmd /c del /y " & strFolder & "\*.*", 0, True

VBScript error problems: Expected End 800A03F6

I am trying to make a vbs work, the idea is it will remotely install an msi, to a list of machines contained with a txt file.
I am getting multiple errors, the first is:
wrong number of arguments or invalid property assignment: "WshShell.Exec" Line 27, Char 1
WshShell.Exec "%COMSPEC% /C COPY " & StrInstallFile & " \\" & strComputer _
& "\C$\Windows\Temp", 0, TRUE
I seemd to have got round this with:
Set WshExec = WshShell.Exec......
then got:
expected end of statement line 27 cahr 29
adding an &:
Set WshExec = WshShell.Exec & "%COMSPEC%.....
now gets me:
expected end of statement line 27 char 110
which is the penultimate comma
Set WshExec = WshShell.Exec & "%COMSPEC% /C COPY" & StrInstallFile _
& " \\" & strComputer & "\C$\Windows\Temp", 0, TRUE
so i am not sure what is wrong at this point, and whether changing the whole line to a set was the right thing to have done.
You are mixing .Run and .Exec. The prototype for .Exec:
object.Exec(strCommand)
shows that you need someting like:
Set oExec = WshShell.Exec("%COMSPEC% /C COPY " & StrInstallFile & " \" & strComputer & "\C$\Windows\Temp")
If you want .Run instead, try something like:
Dim iRet : iRet = WshShell.Run(strCommand, [intWindowStyle], [bWaitOnReturn])
Dim iRet : iRet = WshShell.Run("%comspec% ...", 0, True)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("MachineList.Txt", 1)
StrInstallFile="install_flash_player_11_active_x.msi"
StrNoUpdateFile="mms.cfg"
StrInstallCMD="msiexec.exe /qn /i "
Do Until objFile.AtEndOfStream
strComputer = objFile.ReadLine
' --------- Check If PC is on -------------
Set WshShell = WScript.CreateObject("WScript.Shell")
Set WshExec = WshShell.Exec("ping -n 1 -w 1000 " & strComputer) 'send 3 echo requests, waiting 2secs each
strPingResults = LCase(WshExec.StdOut.ReadAll)
If InStr(strPingResults, "reply from") Then
' ---------- Successful ping - run remote commands ----------------
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
' --------- Copy msi to windows temp folder
Set oExec = WshShell.Exec("%COMSPEC% /C COPY " & StrInstallFile & " \\" & strComputer & "\C$\Windows\Temp")
' --------- execute msi file on remote machine
Set oExec = WshShell.Exec("%COMSPEC% /C psexec \\" & StrComputer & " " & strInstallCMD & "c:\Windows\Temp\" & StrInstallFile)
' --------- Copy no "no update" file to remote machine, first line is for win7, second for xp
Set oExec = WshShell.Exec("%COMSPEC% /C COPY " & StrNoUpdateFile & " \\" & strComputer & "\C$\Windows\SysWOW64\Macromed\Flash")
Set oExec = WshShell.Exec("%COMSPEC% /C COPY " & StrNoUpdateFile & " \\" & strComputer & "\C$\Windows\system32\macromed\flash")
Else
' ---------- Unsuccessful ping - Leave computer name in MachineList.txt and continue ----------------
strNewContents = strNewContents & strComputer & vbCrLf
End If
Loop
objFile.Close
Set objFile = objFSO.OpenTextFile("MachineList.txt", 2)
objFile.Write strNewContents
objFile.Close

set permissions with a vbs script

I have a VBS script that downloads a file on login and places it in a given folder, It works brilliantly in some places but in others it falls over because the file was created by user1 and user2 can't overwrite it.
How would i give the group "Everyone" full control of a given file using a VBS script?
Something like this:
Set WshShell = CreateObject("WScript.Shell")
strFile = "c:\test_folder\test_file.txt"
setPerms = "%COMSPEC% /c echo Y| C:\windows\system32\cacls.exe " & Chr(34) & strFile & Chr(34) & " /G domain\everyone:F"
wscript.echo setPerms
WshShell.run setPerms
Partially gleaned from here:
http://social.technet.microsoft.com/forums/en-us/ITCG/thread/6CDA091A-6B3D-4F58-8374-9A46F59F389A
One way of doing it would be to use the CACLS command line tool. Just run it from your script using Shell.Run.
Here's another link to information about how to use CACLS that has some samples.
Function giveFullPermissionToFolder(strFolder)
Dim objShell, strCmd, intRunError
Set objShell = CreateObject("Wscript.Shell")
strCmd = "%comspec% /c echo Y| cacls " & strFolder & " /T /E /C /G Users:F"
intRunError = objShell.Run(strCmd, 2, True)
If intRunError<>0 Then
Reporter.ReportEvent micFail, "giveFullPermissionToFolder" , "Unable to give full permission to " & strFolder
End If
Set objShell=Nothing
End Function

Resources