Popup to appear and close with a target process - vbscript

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.

Related

Can't find where "Expected End of Statement is"

So I am creating a code in VBS to automate setting up computers. Step 1 of my code works well, Step 2 not implemented in this example but works good, Step 3 throws me a "Expected end of Statement" error at Command_3A.
The string I am trying to set is start "Lightspeed" /wait /i "Programs\Lightspeed\UserAgentx64 V2.1.14.msi"
I have tried these ways but I am missing something.
Command_3A = "start "Lightspeed" /wait /i "Programs\Lightspeed\UserAgentx64 V2.1.14.msi" "`
Command_3A = "start " ""Lightspeed"" " /wait /i " ""Programs\Lightspeed\UserAgentx64 V2.1.14.msi"" "`
Command_3A = (start "Lightspeed" /wait /i "C:\Users\ccollins\Desktop\ThumbDrive\Programs\Lightspeed\UserAgentx64 V2.1.14.msi" )`
Here is my code:
'Dim objShell
Set objShell = WScript.CreateObject ("WScript.Shell")
Drive_Letter = "C:"
File_Path = "C:\Users\ccollins\Desktop\ThumbDrive\"
' Step 1 - Set Power Settings
Command_1A = "powercfg /change standby-timeout-ac 0"
Command_1B = "powercfg /change standby-timeout-dc 15"
Command_1C = "powercfg /change monitor-timeout-ac 0"
Command_1D = "powercfg /change monitor-timeout-dc 15"
Command_1E = "powercfg /change hibernate-timeout-ac 0"
Command_1F = "powercfg /change hibernate-timeout-dc 15"
objShell.Run "cmd /k " & Command_1A & "&" & Command_1B & "&" & Command_1C & "&" & Command_1D & "&" & Command_1E & "&" & Command_1F & "& exit"
' Step 2 - Remove Bloatware (Win10Apps)
' Step 3 - Install wanted programs
Command_3A = (start "Lightspeed" /wait /i "C:\Users\ccollins\Desktop\ThumbDrive\Programs\Lightspeed\UserAgentx64 V2.1.14.msi" )
Command_3B = "start "Acrobat" /wait "Programs\AcroRdrDC1801120058_en_US.exe" /sAll "
Command_3C = "start "AZMerit" /wait /I "Programs\AzMERITSecureBrowser10.4-2018-08-02.msi" /passive "
Command_3D = "start "Java" /wait "Programs\jre-8u201-windows-x64.exe" /s "
Command_3E = "start "Chrome" /wait "Programs\ChromeStandaloneSetup64.exe" /silent /install "
Command_3F = "start "Eset" /wait "Programs\ESet Rip and Replace.exe" "
objShell.Run "cmd /k " & Drive_Letter & "&" & Command_3A & "&" & Command_3B & "&" & Command_3C & "&" & Command_3D & "&" & Command_3E & "&" & Command_3F & "& exit"
Set oShell = Nothing'
I am definitely missing something and just need another set of eyes to look at my code.
So this is what I came up with. I had to use Chr(34) for the " in the code that wanted inserted as part of the command. I also inserted an input box for sPath and UAC control.
Set wshShell = WScript.CreateObject("WScript.Shell")
dim sPath
' ----------------------------------------------------------'
' UAC Control
If WScript.Arguments.Length = 0 Then
Set objShell = CreateObject("Shell.Application")
objShell.ShellExecute "wscript.exe" _
, Chr(34) & WScript.ScriptFullName & Chr(34) & " RunAsAdministrator", , "runas", 1
WScript.Quit
End If
'Step 0 - Set Drive Letter or File Path
sPath = InputBox("Enter the Path to the Drive. If entering just drive letter then add :, if file path remove the end \")
' Step 1 - Set Power Settings
' Step 2 - Remove Bloatware (Win10Apps)
' Step 3 - Install wanted programs
Function GetOsBits()
Set shell = CreateObject("WScript.Shell")
If shell.ExpandEnvironmentStrings("%PROCESSOR_ARCHITECTURE%") = "AMD64" Then
GetOsBits = 64
Else
GetOsBits = 32
End If
End Function
Command_3A = Chr(34) & sPath & "\Programs\Lightspeed\UserAgentx64 V2.1.14.msi" & Chr(34)
Command_3B = Chr(34) & sPath & "\Programs\Lightspeed\UserAgentx86 V2.1.14.msi" & Chr(34)
Command_3C = Chr(34) & sPath & "\Programs\AcroRdrDC1801120058_en_US.exe" & Chr(34) & "& /sAll "
Command_3D = Chr(34) & sPath & "\Programs\Java\jre-8u201-windows-x64.exe" & Chr(34) & "& /s "
Command_3E = Chr(34) & sPath & "\Programs\Java\jre-8u201-windows-i586.exe" & Chr(34) & "& /s "
Command_3F = Chr(34) & sPath & "\Programs\Chrome\ChromeStandaloneSetup64.exe" & Chr(34) & "& /silent /install "
Command_3G = Chr(34) & sPath & "\Programs\Chrome\ChromeStandaloneSetupi586.exe" & Chr(34) & "& /silent /install "
Command_3H = Chr(34) & sPath & "\Programs\ESet Rip and Replace.exe" & Chr(34)
If GetOsBits = 64 Then
wshShell.Run(Command_3A) 'LightSpeed
wscript.Sleep 4000
wshShell.Run(Command_3C) 'Adobe Reader
wscript.Sleep 30000
wshShell.Run(Command_3D) 'Java
wscript.Sleep 30000
wshShell.Run(Command_3F) 'Chrome
wscript.Sleep 30000
wshShell.Run(Command_3H) 'Eset
wscript.Sleep 30000
Else
wshShell.Run(Command_3B) 'LightSpeed x86
wscript.Sleep 4000
wshShell.Run(Command_3C) 'Adobe Reader
wscript.Sleep 4000
wshShell.Run(Command_3E) 'Java x86
wscript.Sleep 30000
wshShell.Run(Command_3G) 'Chrome x86
wscript.Sleep 30000
wshShell.Run(Command_3H) 'Eset
wscript.Sleep 30000
End If
Set oShell = Nothing

Windows features listing in VBS

I had problems with a code to list the features of windows 7 x64, so far I have been testing with the following code , I hope you can help
Set objShell = CreateObject("WScript.Shell")
comspec = objShell.ExpandEnvironmentStrings("%comspec%")
Set objShell2 = CreateObject("Shell.Application")
Set objExec = objShell.Exec(comspec & " /k dism /online /get-features")
Do
line = objExec.StdOut.ReadLine()
s = s & line & vbcrlf
Loop While Not objExec.Stdout.atEndOfStream
WScript.Echo s
I don't understand your "I could not run the dism with privilege". Next script auto elevates itself if possible:
Option Explicit
On Error GoTo 0
Dim objShell, comspec, objShell2, objExec, line, s, sErrLine
Set objShell = CreateObject("WScript.Shell")
comspec = objShell.ExpandEnvironmentStrings("%comspec%")
sErrLine = ""
Set objShell2 = CreateObject("Shell.Application")
Set objExec = objShell.Exec(comspec _
& " /V:ON /c dism /online /Format:Table /get-features" _
& "||echo error=!errorlevel! occurred&exit")
Do
line = objExec.StdOut.ReadLine()
If line = "error=740 occurred" Then sErrLine = line
s = s & line & vbcrlf
Loop While Not objExec.Stdout.atEndOfStream
If sErrLine = "" Then
WScript.Echo s
Else
If WScript.Arguments.Named.Exists("autoelevated") Then
WScript.Echo s & vbNewLine & "Auto elevate failed, try 'Run as administrator'"
Else
If InStr(1, Wscript.FullName, "WSCript.exe", vbTextCompare) > 0 Then
' auto elevate if current host is WSCript
objShell2.ShellExecute Wscript.FullName _
, Wscript.ScriptFullName & " /autoelevated", "", "runas", 1
' another way of auto elevate if default host is WSCript
' objShell2.ShellExecute Wscript.ScriptFullName, " /autoelevated", "", "runas", 1
ElseIf InStr(1, Wscript.FullName, "CSCript.exe", vbTextCompare) > 0 Then
' auto elevate if current host is CSCript (invokes another 'cmd' instance)
objShell2.ShellExecute comspec, " /K " _
& Wscript.FullName & " " & Wscript.ScriptFullName & " /autoelevated" _
, "", "runas", 1
Else
WScript.Echo s & vbNewLine & "Can't auto elevate, try 'Run as administrator'"
End If
End If
End If
Remove the parenthesis
Set objShell = CreateObject("shell.application")
comspec = objShell.ExpandEnvironmentStrings("%comspec%")
Set objShell2 = CreateObject("Shell.Application")
Set objExec = objShell.shellExec "comspec", " /k dism /online /get-features"
', <dir (if any, if not leave blank)>, <verb (ie. runas, etc.)>,
' <window style>
' normal=1, hide=0, 2=Min, 3=max, 4=restore, 5=current, 7=min/inactive, 10=default
Do
line = objExec.StdOut.ReadLine()
s = s & line & vbcrlf
Loop While Not objExec.Stdout.atEndOfStream
WScript.Echo s

synchronize run methods vbscript

I have a problem. I need to throw some synchronized commands in vbscript (one Run method, Delete one and moveFile one) in every cycle to my loop. I don't know how I do it.
My code is that:
Public Function UnificarCRIs(ByVal path, ByVal FICRIEC, ByVal sessio, ByVal CIBAA)
Dim objFile, objCurrentFolder, filesys, origenFitxers
Dim FileName, WshShell
On error resume next
Set filesys = CreateObject("Scripting.FileSystemObject")
Set WshShell = WScript.CreateObject("WScript.Shell")
Set objCurrentFolder = filesys.getFolder(path)
For Each objFile In objCurrentFolder.Files
FileName = objFile
If (right(FileName, 4) = ".cri") Then
If filesys.FileExists(path & FICRIEC & sessio) Then
'WshShell.Run ("copy " & path & FICRIEC & sessio & "+" & FileName & " " & path & FICRIEC & sessio & "_tmp")
WshShell.run ("cmd /K " & "copy /Y " & path & FICRIEC & sessio & "+" & FileName & " " & path & FICRIEC & sessio & "_tmp",8,TRUE)
Set WshShell = Nothing
filesys.DeleteFile path & FICRIEC & sessio
'filesys.MoveFile path & FICRIEC & sessio & "_tmp", path & FICRIEC & sessio
Else
WshShell.run "cmd /K " & "copy /Y " & FileName & " " & path & FICRIEC & sessio,8,TRUE
Set WshShell = Nothing
End If
End If
Next
End Function
Read the docs for .Run completely and reflect on the bWaitOnReturn parameter.
Apology:
Sorry, I didn't read your code carefully enough. The .Run should wait. But I see that you use a global On Error Resume Next and param list () in
WshShell.run ("cmd /K " & "copy /Y " & path & FICRIEC & sessio & "+" & FileName & " " & path & FICRIEC & sessio & "_tmp",8,TRUE)
What happens, when you remove those mistakes? Are you sure, that you have a usable WshShell in the second pass thru the loop?

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

VBScript WSHell.Run Multiple Processes

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

Resources