'****************************************************
'		Script Witten by Larry Heintz
'		April 2006 www.windowsadminscripts.com
' This script will allow you to move applications
' from one Application Pool to another Application
' Pool. You can also list the application pools on the
' server.
'
' This must be ran from a Windows 2003 server.
'
' Script Usage:
' Move Apps from One App Pool to Another App Pool:
'  apmoves.vbs /computer:[computername] /oldap:"[App Pool Name]" /newap:"[App Pool Name]"
' List App Pools:
'  apmoves.vbs /computer:[computername] /list
'****************************************************
Dim args,computername,oldapname,newapname
Set args = Wscript.Arguments.Named
computername = args.Item("computer")
oldapname = trim(lcase(args.Item("oldap")))
newapname = trim(lcase(args.Item("newap")))

if computername = "" then
	computername = getComputer()
else
	computername = computername
end if

if wscript.arguments.count = 0 then
	wscript.echo "Script Usage:"
	wscript.echo "Move Apps from One App Pool to Another App Pool:"
	wscript.echo " apmoves.vbs /computer:[computername] /oldap:""[App Pool Name]"" /newap:""[App Pool Name]"""
	wscript.echo "List App Pools:"
	wscript.echo " apmoves.vbs /computer:[computername] /list"
	wscript.quit
elseif args.exists("list") then
	Call enumAppPools()
elseif args.exists("oldap") and args.exists("newap") then
	if oldapname = "" then
		wscript.echo "The script has ended due to no Old Application Pool name given (/old:)"
		wscript.quit
	else
		if instr(AppPoolsArray(),oldapname) <> 0 then
			oldapname = oldapname
		else
			wscript.echo "The Old Application Pool does not exist."
			wscript.quit
		end if
	end if
	if newapname = "" then
		wscript.echo "The script has ended due to no New Application Pool name given (/new:)"
		wscript.quit
	else
		if instr(AppPoolsArray(),newapname) <> 0 then
			newapname = newapname
		else
			wscript.echo "The New Application Pool does not exist. Please create it then run the script again"
			wscript.quit
		end if
	end if
else
	wscript.echo "Script Usage:"
	wscript.echo "Move Apps from One App Pool to Another App Pool:"
	wscript.echo " apmoves.vbs /computer:[computername] /oldap:""[App Pool Name]"" /newap:""[App Pool Name]"""
	wscript.echo "List App Pools:"
	wscript.echo " apmoves.vbs /computer:[computername] /list"
	wscript.quit
end if

Call enumoldAPool(oldapname,newapname)

Function enumoldAPool(oldapname,newapname)
On Error Resume Next
Dim obj,app,temp,obj1,AppsInPool
set obj = GetObject("IIS://" & computername & "/W3SVC/apppools/" & oldapname)
if not (errorChecking (computername)) then 
	AppsInPool = obj.EnumAppsInPool
	for each app in AppsInPool
		temp = split(app,"/")
		set obj1 = GetObject("IIS://" & computername & "/W3SVC/" & temp(3))
			Call changeAPool(temp(3),newapname)
			wscript.echo obj1.ServerComment & " moved to Application Pool " & newapname
		set obj1 = nothing
	next
end if
set obj = nothing	
End Function

Function changeAPool(index,newapname)
Dim obj
set obj = GetObject("IIS://" & computername & "/W3SVC/" & index & "/ROOT")
	obj.AppPoolID = newapname
	obj.setinfo
End Function

Sub enumAppPools()
On Error Resume Next
Dim apool,obj
set obj = GetObject("IIS://" & computername & "/W3SVC/apppools")
if not (errorChecking (computername)) then
	wscript.echo "Application Pool Names on " & ucase(computername)
	wscript.echo "========================================"
	for each apool in obj
		wscript.echo apool.name
	next
end if
set obj = nothing
End Sub

Function AppPoolsArray()
On Error Resume Next
Dim apool,obj
set obj = GetObject("IIS://" & computername & "/W3SVC/apppools")
if not (errorChecking (computername)) then
	for each apool in obj
		AppPoolsArray = AppPoolsArray + lcase(apool.name) & ","
	next
end if
set obj = nothing
End Function

Function getComputer()
	Dim objNet
	Set objNet = WScript.CreateObject("WScript.Network") 
	getComputer = objNet.ComputerName 
	Set objNet = Nothing 
End Function

Function errorChecking(computername) 
errorChecking = False 
if err.number <> 0 then 
	wscript.echo "Unable to connect to " & ucase(computername) & " or " & ucase(computername) & " is not running IIS 6.0"
	err.Clear () 
	errorChecking = True
	wscript.quit
end if
end Function