VBS To Lower Some Processes

[gunsmokingman]

Here is a VBS script that will lower these services

'/-> Array For Services To Lower
 Dim ObjPro	  : ObjPro = Array(_
	"SearchFilterHost.exe", "SearchIndexer.exe", "SearchProtocolHost.exe",_
	"SLsvc.exe", "spoolsv.exe", "TrustedInstaller.exe", "wmpnscfg.exe")

I choosed these services to lower instead of turning them off. I have this start from the All User Start Menu.

Script

Save as LowerVistaServices.vbs

'/-> Priority Level For TaskManager 
 Const Normal = 32
 Const Low = 64
 Const High = 256
 Const RealTime = 128
 Const BELOW_NORMAL = 16384
 Const Above_Normal = 32768
'/-> Varibles 
 WScript.Sleep 15000
  Dim strComputer : strComputer = "."
  Dim ColPro, ObjWmi, ObjPro, objProcess, StrObj, StrRpt
'/-> Array For Services 
   ObjPro = Array("SearchFilterHost.exe", "SearchIndexer.exe", "SearchProtocolHost.exe",_
	"SLsvc.exe", "TrustedInstaller.exe", "wmpnscfg.exe")

   Set ObjWmi = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
'/-> Collect The Array Names, Then Turn Down The Service
	For Each StrObj In ObjPro
	 Set colProcesses = ObjWmi.ExecQuery _
	  ("Select * from Win32_Process Where Name = '" & StrObj & "'")
	   For Each objProcess in colProcesses
	   objProcess.SetPriority(Low) 
	  StrRpt = StrRpt & vbCrLf & objProcess.Name 
	 Next
   Next 

   CreateObject("Wscript.Shell").Popup "Completed Lowering The Priority Levels" &_
   vbCrLf & StrRpt, 3,"Completed", 0 + 32

This is the VBS script I use to install it from the SFX file included

Const ALL_USERS_STARTUP = &H18&
 Const OverwriteExisting = TRUE
  Dim Shell : Set Shell = CreateObject("Shell.Application")
  Dim Fso   : Set Fso = CreateObject("Scripting.FileSystemObject")
  Dim Act   : Set Act = CreateObject("Wscript.Shell")
  Dim Vbs1, Vbs2, AllUserStart
   Vbs1 = Act.ExpandEnvironmentStrings("%SystemDrive%\LowerVistaServices.vbs")
   Vbs2 = Act.ExpandEnvironmentStrings("%SystemDrive%\InstallLowerProcess.vbs")
   Set objFolder = Shell.Namespace(ALL_USERS_STARTUP)
   Set objFolderItem = objFolder.Self
	  AllUserStart = objFolderItem.Path
	 If Fso.FileExists(Vbs1) Then 
	  Fso.CopyFile(Vbs1), (AllUserStart & "\\LowerVistaServices.vbs"), OverwriteExisting	  
	   Act.Popup "Confirm Installed Completed" & Space(7) & Vbs1, 3, "Completed", 0 + 32
	  Act.Run(Chr(34) & Vbs1 & Chr(34)), 1, True 
	 End If 
	If Fso.FileExists(Vbs1) Then Fso.DeleteFile(Vbs1) End If 
	If Fso.FileExists(Vbs2) Then Fso.DeleteFile(Vbs2) End If

I have made the above 2 Vbs Script into 1 here is the updated script

Save As LowerSvcInstall.vbs

Const ALL_USERS_STARTUP = &H18&, OverwriteExisting = TRUE
 Dim Shell   : Set Shell = CreateObject("Shell.Application")
 Dim Fso	 : Set Fso = CreateObject("Scripting.FileSystemObject")
 Dim Act	 : Set Act = CreateObject("Wscript.Shell")
 Dim Vbs1	: Vbs1 = Act.ExpandEnvironmentStrings("%SystemDrive%\LowerSvcInstall.vbs") 
 Dim StrFldr : Set StrFldr = Shell.Namespace(ALL_USERS_STARTUP)
 Dim FldrObj : Set FldrObj = StrFldr.Self
 Dim AUStart : AUStart = FldrObj.Path
 Dim Vbs2	: Vbs2 = (AUStart & "\VistaLowerSrv.vbs")
'/-> Create The Vbs Script For All User Start Menu 
 Dim Ts	  : Set Ts = Fso.CreateTextFile(Vbs2) 
   Ts.WriteLine "'/-> Priority Level For TaskManager" 
   Ts.WriteLine " Const Normal = 32, Low = 64, High = 256, RealTime = 128"
   Ts.WriteLine " Const BELOW_NORMAL = 16384, Above_Normal = 32768"
   Ts.WriteLine "'/-> Varibles" 
   Ts.WriteLine "  WScript.Sleep 15000"
   Ts.WriteLine " Dim strComputer : strComputer = ""."""
   Ts.WriteLine " Dim Act		 : Set Act = CreateObject(""Wscript.Shell"")"
   Ts.WriteLine " Dim ObjWmi	  : Set ObjWmi = GetObject(""winmgmts:\\"" & strComputer & ""\root\cimv2"")"
   Ts.WriteLine "'/-> Array For Services To Lower" 
   Ts.WriteLine " Dim ObjPro	  : ObjPro = Array(_"
   Ts.WriteLine "	""SearchFilterHost.exe"", ""SearchIndexer.exe"", ""SearchProtocolHost.exe"",_"
   Ts.WriteLine "	""SLsvc.exe"", ""spoolsv.exe"", ""TrustedInstaller.exe"", ""wmpnscfg.exe"")"  
   Ts.WriteLine "'/-> Varibles"
   Ts.WriteLine " Dim ColPro, ColSrv, ObjSrv, StrObj, StrRpt"
   Ts.WriteLine "'/-> Collect The Array Names, Then Turn Down The Service"
   Ts.WriteLine "  For Each StrObj In ObjPro"
   Ts.WriteLine "  Set ColSrv = ObjWmi.ExecQuery(""Select * from Win32_Process Where Name = '"" & StrObj & ""'"")"
   Ts.WriteLine "   For Each ObjSrv in ColSrv"
   Ts.WriteLine "	ObjSrv.SetPriority(Low)" 
   Ts.WriteLine "	StrRpt = StrRpt & vbCrLf & Space(3) & ObjSrv.Name" 
   Ts.WriteLine "	Next"
   Ts.WriteLine "   Next"
   Ts.WriteLine "  Act.Popup ""Completed Lowering The Priority Levels"" & StrRpt, 5,""Completed"", 0 + 32 + 4096"
   Ts.Close  
	If Fso.FileExists(Vbs2) Then 
	 Act.Popup "Confirm Installed Completed" , 3, "Completed", 0 + 32 + 4096
	 Act.Run(Chr(34) & Vbs2 & Chr(34)),0,True 
	End If 
   If Fso.FileExists(Vbs1) Then Fso.DeleteFile(Vbs1) End If

LowerVistaSrv.exe

Edited August 19, 2006 by gunsmokingman

[fizban2]

very nice GSM,

do you see a big difference with these services lowered?

[gunsmokingman]

It could be me but there seems to some speed improvement.

[gunsmokingman]

I have made some changes to the SFX file,there was 2 vbs script inside the first one

this now is only 1 vbs script. I have it make a Vbs Script in the all user start menu.

Const ALL_USERS_STARTUP = &H18&, OverwriteExisting = TRUE
 Dim Shell   : Set Shell = CreateObject("Shell.Application")
 Dim Fso	 : Set Fso = CreateObject("Scripting.FileSystemObject")
 Dim Act	 : Set Act = CreateObject("Wscript.Shell")
 Dim Vbs1	: Vbs1 = Act.ExpandEnvironmentStrings("%SystemDrive%\LowerSvcInstall.vbs") 
 Dim StrFldr : Set StrFldr = Shell.Namespace(ALL_USERS_STARTUP)
 Dim FldrObj : Set FldrObj = StrFldr.Self
 Dim AUStart : AUStart = FldrObj.Path
 Dim Vbs2	: Vbs2 = (AUStart & "\VistaLowerSrv.vbs")
'/-> Create The Vbs Script For All User Start Menu 
 Dim Ts	  : Set Ts = Fso.CreateTextFile(Vbs2) 
   Ts.WriteLine "'/-> Priority Level For TaskManager" 
   Ts.WriteLine " Const Normal = 32, Low = 64, High = 256, RealTime = 128"
   Ts.WriteLine " Const BELOW_NORMAL = 16384, Above_Normal = 32768"
   Ts.WriteLine "'/-> Varibles" 
   Ts.WriteLine "  WScript.Sleep 15000"
   Ts.WriteLine " Dim strComputer : strComputer = ""."""
   Ts.WriteLine " Dim Act		 : Set Act = CreateObject(""Wscript.Shell"")"
   Ts.WriteLine " Dim ObjWmi	  : Set ObjWmi = GetObject(""winmgmts:\\"" & strComputer & ""\root\cimv2"")"
   Ts.WriteLine "'/-> Array For Services To Lower" 
   Ts.WriteLine " Dim ObjPro	  : ObjPro = Array(_"
   Ts.WriteLine "	""SearchFilterHost.exe"", ""SearchIndexer.exe"", ""SearchProtocolHost.exe"",_"
   Ts.WriteLine "	""SLsvc.exe"", ""spoolsv.exe"", ""TrustedInstaller.exe"", ""wmpnscfg.exe"")"  
   Ts.WriteLine "'/-> Varibles"
   Ts.WriteLine " Dim ColPro, ColSrv, ObjSrv, StrObj, StrRpt"
   Ts.WriteLine "'/-> Collect The Array Names, Then Turn Down The Service"
   Ts.WriteLine "  For Each StrObj In ObjPro"
   Ts.WriteLine "  Set ColSrv = ObjWmi.ExecQuery(""Select * from Win32_Process Where Name = '"" & StrObj & ""'"")"
   Ts.WriteLine "   For Each ObjSrv in ColSrv"
   Ts.WriteLine "	ObjSrv.SetPriority(Low)" 
   Ts.WriteLine "	StrRpt = StrRpt & vbCrLf & Space(3) & ObjSrv.Name" 
   Ts.WriteLine "	Next"
   Ts.WriteLine "   Next"
   Ts.WriteLine "  Act.Popup ""Completed Lowering The Priority Levels"" & StrRpt, 5,""Completed"", 0 + 32 + 4096"
   Ts.Close  
	If Fso.FileExists(Vbs2) Then 
	 Act.Popup "Confirm Installed Completed" , 3, "Completed", 0 + 32 + 4096
	 Act.Run(Chr(34) & Vbs2 & Chr(34)),0,True 
	End If 
   If Fso.FileExists(Vbs1) Then Fso.DeleteFile(Vbs1) End If

Up Dated LowerVistaSrv.exe

Edited August 19, 2006 by gunsmokingman

[fizban2]

wow,

i have seen a very nice speed improvement with the services lowered. Very nice GSM keep it up