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

'/-> 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

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

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