Option Explicit
' Common objects
Dim fso, wso
Set fso = CreateObject("Scripting.FileSystemObject")
Set wso = CreateObject ("WScript.Shell")

Class Version
	public major
	public minor	
End Class

' Common functions
' Registry functions
Function ReadRegistryKey(key, ByRef value)
	On Error Resume Next
	Dim wso
	Set wso=CreateObject ("WSCript.Shell")	
	value = wso.RegRead(key)
	If Err.Number <> 0 Then
		Err.Clear
		value = ""
		ReadRegistryKey = 1
		Exit Function
	End If
	ReadRegistryKey = 0
End Function

Sub WriteRegistryKey(key, value)
	WriteRegistryKeyEx key, value, "REG_SZ"
End Sub

Sub WriteRegistryKeyEx(key, value, keyType)
	On Error Resume Next
	
	LogProgress vbTab & "Writing registry value '" & value & "' to key '" & key & "'"
	
	Dim wso
	Set wso=CreateObject ("WSCript.Shell")	
	wso.RegWrite key, value, keyType
	If Err.Number <> 0 Then	FailedQuit "Failed to write registry value '" & value & "' to key '" & key & "'"
End Sub

' Logging functions
Function FailedQuit(msg)
	LogError msg
	WScript.Quit -1
End Function

Function LogProgress(msg)
	WScript.Echo msg
End Function

Function LogError(msg)
	WScript.StdErr.Write "[ERROR] " & msg & vbCrLf
End Function

'Check process status

Function ProcessIsRunning( intProcessID )
    Dim colProcessList

    Set colProcessList = Getobject("Winmgmts:").ExecQuery _
        ("Select * from Win32_Process Where ProcessID =" & intProcessID)
    If colProcessList.Count > 0 Then
        ProcessIsRunning = True
    Else
        ProcessIsRunning = False
    End If

    Set colProcessList = Nothing
End Function

Sub WaitForProcess( intProcessID )

  If ProcessIsRunning(intProcessID) Then
    Dim w : w = 0
    Dim intPause : intPause = 1

    'Loop while the process is running
    Do While ProcessIsRunning(intProcessID)
      'Check to see if specified # of seconds have passed before terminating
      'the process. If yes, then terminate the process
      'Increment the seconds counter
      w = w + intPause
      'Pause
      Wscript.Sleep(intPause * 1000)
    Loop
  End If
End Sub

' Exec process x64
Function ExecuteProcessWow64(strServer, strUser, strPassword, strCommand, strName)

	Dim objLocator , objWMIService , objStartup , objConfig
	Dim intProcessID , intReturn , Process
	Dim wbemImpersonationLevelImpersonate : wbemImpersonationLevelImpersonate = 3
	Dim wbemAuthenticationLevelPktPrivacy : wbemAuthenticationLevelPktPrivacy = 6
	ExecuteProcessWow64 = -1

	Set objLocator = CreateObject("WbemScripting.SWbemLocator")

	On Error Resume Next
	
	Set objWMIService = objLocator.ConnectServer(strServer,"root\cimv2", strUser,strPassword)

	objWMIService.Security_.ImpersonationLevel = wbemImpersonationLevelImpersonate
	objWMIService.Security_.AuthenticationLevel = wbemAuthenticationLevelPktPrivacy

	If Err.Number <> 0 Then
		LogError "Failed to connect to " &strServer, "Error # " & CStr(Err.Number) & " " & Err.Description & vbcrlf & _
		"Please check if " & strServer & " is pingable from this client & credentials are correct"
		Err.Clear
		On Error GoTo 0
		ExecuteProcessWow64 = -1
		Set objWMIService = nothing
		Set objLocator = nothing
		Exit Function
	end if

	' Configure the process to show a window
	Set objStartup = objWMIService.Get("Win32_ProcessStartup")
	Set objConfig = objStartup.SpawnInstance_
      	objConfig.ShowWindow = 0
       
        Set Process = objWMIService.Get("Win32_Process")
       
      	'Process.Create Syntax: ' 
	'       uint32 Create(
	'[in]   string CommandLine,
      	'[in]   string CurrentDirectory,
      	'[in]   Win32_ProcessStartup ProcessStartupInformation,
      	'[out]  uint32 ProcessId
      	');
    
     	'Return code Description
      	'0     Successful Completion
      	'2     Access Denied
      	'3     Insufficient Privilege
      	'8     Unknown failure
      	'9     Path Not Found
      	'21    Invalid Parameter
   
        intReturn = Process.Create(strCommand,NULL, objConfig, intProcessID)

        If intReturn <> 0 Then
        	FailedQuit "Process could not be created." & vbNewLine & "Executing: " & strCommand & vbNewLine & "Return value: " & intReturn
		ExecuteProcessWow64 = intReturn
            	Exit Function
        Else
          	LogProgress "Process created." & vbNewLine & "Executing: " & strCommand & vbNewLine & "Process ID: " & intProcessID
        End If
     
	Set objWMIService = nothing
	Set objLocator = nothing

	WaitForProcess intProcessID

	ExecuteProcessWow64 = 0
End Function 

' Exec program
Function ExecProgram(cmd, strInput, ByRef strOutput, ByRef strError)
	On Error Resume Next

	LogProgress vbTab & "Executing '" & cmd & "'"
	
	Dim oExec
	Set oExec = wso.Exec(cmd)

	If Err.number <> 0 Then
		strError = Err.Description
		ExecProgram = Err.number
		Exit Function
	End If

	oExec.StdIn.Write strInput
	oExec.StdIn.Close
	
	strOutput = oExec.StdOut.ReadAll
	strError = oExec.StdErr.ReadAll
	
	Do 
		WScript.Sleep 100
		If Not oExec.StdOut.AtEndOfStream Then
			strOutput = strOutput & oExec.StdOut.ReadAll
		End If
		
		If Not oExec.StdErr.AtEndOfStream Then
			strError = strError & oExec.StdErr.ReadAll
		End If
	Loop Until oExec.Status <> 0

	oExec.StdOut.Close
   	oExec.StdErr.Close
    
	ExecProgram = oExec.ExitCode
End Function 

' File functions
Function GetTempFileName
	Dim tfolder, tname
	Const TemporaryFolder = 2
	Set tfolder = fso.GetSpecialFolder(TemporaryFolder)
	GetTempFileName = tfolder.Path & "\" & fso.GetTempName
End Function

Function GetOSx() 
	Dim strComputer : strComputer = "." 
	Dim objOs
	Dim objWmiService : Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\"& strComputer & "\root\cimv2") 
	Dim strOsQuery : strOsQuery = "Select * from Win32_OperatingSystem" 
	Dim colOperatingSystems : Set colOperatingSystems = objWMIService.ExecQuery(strOsQuery) 

	For Each objOs in colOperatingSystems
		Dim x, y
		x = Split(objOs.Version,".")
		Set y = new Version
		y.major = x(0)
		y.minor = x(1)
		Set GetOSx = y
	Next 
End Function

Function GetOS() 
	GetOS = GetOSx().major
End Function

' Service functions
Function SetServiceAutostart(name)
	On Error Resume Next
	Dim Locator, Services, Service, ret

	Dim wbemImpersonationLevelImpersonate : wbemImpersonationLevelImpersonate = 3
	Dim wbemAuthenticationLevelPktPrivacy : wbemAuthenticationLevelPktPrivacy = 6

	LogProgress "Changing service '" & name & "' startmode"

	Const COMPUTER = "."
	
	Set Locator = CreateObject("WbemScripting.SWbemLocator")
	Set Services = Locator.ConnectServer(".")
	If Err Then
		LogError "Failed to connect server '.' - " & Err.Description
		SetServiceAutoStart = Err.number
		Exit Function
	End If
	Locator.Security_.ImpersonationLevel = wbemImpersonationLevelImpersonate
	Locator.Security_.AuthenticationLevel = wbemAuthenticationLevelPktPrivacy
	Set Service = Services.Get("Win32_Service='" & name & "'")
	If Err Then
		LogError "Failed to get service " & name & " - " & Err.Description
		SetServiceAutoStart = Err.number
		Exit Function
	End If
	ret = Service.Change(, , , , "Automatic")
	If ret <> 0 Then 
		LogError "Failed to change service '" & name & "' start mode"
		SetServiceAutostart = ret
		Exit Function
	End If


	LogProgress vbTab & "Starting service " & name
	Service.StartService
	If Err Then
		LogError "Failed to start service " & name & " - " & Err.Description
		SetServiceAutoStart = Err.number
		Exit Function
	End If
	WaitService Services, Service, name, 1 * 60, "Running"
	If Service.State <> "Running" Then
		LogError "Failed to start service '" & name & "' (" & Service.State & ")"
		SetServiceAutostart = ret
		Exit Function
	End If
End Function

Sub WaitService(Services, ServiceObject, name, seconds, state)
	Dim startTime
	startTime = Timer
	Do While (Timer - startTime < seconds) AND (ServiceObject.State <> state)
		WScript.Sleep 1000
		Set ServiceObject = Services.Get("Win32_Service='" & name & "'")
	Loop
End Sub


' PVA-specific functions
Function SaveUnattendedParameters(iisUnattendedInstall)

	' Save sysocmgr unattended parameters
	Dim fo
	Set fo = fso.OpenTextFile(iisUnattendedInstall, 8, True)
	fo.WriteLine "[Components]"
	fo.WriteLine "iis_www=on"
	fo.WriteLine "aspnet=on"
	fo.WriteLine "iis_asp=on"
	fo.WriteLine "snmp=1"

	fo.Close

End Function

Function RunConfigurator(hinttype)
	Dim cmd, output, error, ret

	cmd = Mid(Wscript.ScriptFullName, 1, InStrRev(Wscript.ScriptFullName, "\")) & "pva-pp-config.exe " & hinttype

	ret = ExecProgram(cmd, "", output, error)
	If ret <> 0 Then 
		LogProgress output
		LogError "Failed exec '" & cmd & "': " & vbCrLf & error
		RunConfigurator = ret
		Exit Function
	Else
		LogProgress output
		LogProgress error
		LogProgress "'" & cmd & "' finished successfully"
	End If

End Function

' PP hints implementation
' Install additional IIS components and run pva-cp-config preInstall
Function PreInstall

	' Get temp file name	
	Dim iisUnattendedInstall, v, sourcePath
	iisUnattendedInstall = GetTempFileName
	If WScript.Arguments.Named.Exists("os_distributive_path") Then
		sourcePath = WScript.Arguments.Named.Item("os_distributive_path")
	End If

	Set v = GetOSx
	If v.major < 6 Then
		' Save sysocmgr unattended parameters
		LogProgress "Saving sysocmgr unattended parameters to file '" & iisUnattendedInstall & "'"
		On Error Resume Next
		SaveUnattendedParameters iisUnattendedInstall
		If Err Then
			LogError "Failed to save sysocmgr unattended parameters - " & Err.Description
			PreInstall = Err.number
			Exit Function
		End If
		On Error Goto 0

		' Set windows distributive path
		If Not IsEmpty(sourcePath) Then
			Const sourcePathKey = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Setup\SourcePath"
			Const servicePackSourcePathKey = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Setup\ServicePackSourcePath"
			LogProgress "Changing default Windows Distributive source path to '" & sourcePath & "'"
			WriteRegistryKey sourcePathKey, sourcePath
			WriteRegistryKey servicePackSourcePathKey, sourcePath
	        End If

		' Exec sysocmgr
		LogProgress "Installing additional IIS components"
		Dim ret, output, error
		ret = ExecProgram("Sysocmgr.exe /x /i:sysoc.inf /u:""" & iisUnattendedInstall & """", "", output, error)

		fso.DeleteFile iisUnattendedInstall, True
	
		If ret <> 0 Then 
			LogError "Failed to install IIS components - " & error
			PreInstall = ret
			Exit Function
		End If

		' Set HTTP SSL service to start automatically
		ret = SetServiceAutostart("HTTPFilter")
		If ret <> 0 Then 
			LogError "Failed to modify HTTPFilter service start mode"
			PreInstall = ret
			Exit Function
		End If

		' Modify services configs
		ret = SetServiceAutostart("IISADMIN")
		If ret <> 0 Then 
			LogError "Failed to modify IISADMIN service start mode"
			PreInstall = ret
			Exit Function
		End If
	ElseIf v.major = 6 And v.minor < 2 Then
		ret = ExecuteProcessWow64(".", "", "", "servermanagercmd.exe -install WAS Web-Server SNMP-Service -allSubFeatures", "ServerManagerCmd.exe")
		LogProgress "servermanagercmd.exe exited with code " & ret
		If ret <> 0 and ret <> 1003 Then
			LogError "Failed to install IIS components"
			PreInstall = ret
			Exit Function
		End If
	Else
		Dim x
		x = "Add-WindowsFeature -Name WAS,Web-Server,SNMP-Service -IncludeAllSubFeature"
		If Not IsEmpty(sourcePath) Then
			x = x & " -Source """ & sourcePath & """"
		End If
		ret = ExecuteProcessWow64(".", "", "", "powershell -Command ""& {" & x & "}""", "powershell.exe")
		LogProgress "powershell.exe exited with code " & ret
		If ret <> 0 and ret <> 1003 Then
			LogError "Failed to install IIS components"
			PreInstall = ret
			Exit Function
		End If
	End If

	' Disable TRACE requests in IIS
	WriteRegistryKeyEx "HKLM\SYSTEM\CurrentControlSet\Services\W3SVC\Parameters\EnableTraceMethod", 0, "REG_DWORD"

	' Set WWW service to start automatically
	ret = SetServiceAutostart("W3SVC")
	If ret <> 0 Then 
		LogError "Failed to modify W3SVC service start mode"
		PreInstall = ret
		Exit Function
	End If

	' Install ASP.NET
	LogProgress "Installing ASP.NET"
	Dim cmd
	cmd = fso.GetSpecialFolder(0) & "\Microsoft.NET\Framework\v1.1.4322\aspnet_regiis -i -enable"
	If GetOS <> 6 Then
		ret = ExecProgram(cmd, "", output, error)
	Else
		ret = ExecuteProcessWow64(".", "", "", cmd, "aspnet_regiis.exe")
	End If

	If ret <> 0 Then
		LogError "Failed to install ASP.NET - " & error
		PreInstall = ret
		Exit Function
	End If

	ret = RunConfigurator("preInstall")
	If ret <> 0 Then
		LogError "Preinstall configuration failed"
		PreInstall = ret
	End If
End Function

Function PreUpgrade
	Dim ret	
	ret = RunConfigurator("preUpgrade")
	If ret <> 0 Then
		LogError "Preupgrade configuration failed"
		PreUpgrade = ret
	End If
End Function

Function PreUninstall
	Dim ret
	ret = RunConfigurator("preUninstall")
	If ret <> 0 Then
		LogError "Preuninstall configuration failed"
		PreUninstall = ret
	End If
End Function

Function Detect64
	Dim s
	Set s = Nothing
	For Each s In GetObject("winmgmts:\\.\root\cimv2").InstancesOf("Win32_ComputerSystem", 0)
		Detect64 = ("x64" = Left(LCase(s.SystemType), 3))
		Exit Function
	Next
	Detect64 = False
End Function

Function WorkaroundAsp11Onx64
	Dim ret : ret = ExecuteProcessWow64(".","","", "cmd /c md \windows\microsoft.net\framework64\v1.1.4322\config\", "md")
	If ret <> 0 Then
		LogError "Failed to create folder"
		WorkaroundAsp11Onx64 = ret
		Exit Function
	End If

	ret = ExecuteProcessWow64(".","","", "cmd /c copy \windows\microsoft.net\framework\v1.1.4322\config\machine.config \windows\microsoft.net\framework64\v1.1.4322\config\", "copy")
	If ret <> 0 Then
		LogError "Failed to copy config"
		WorkaroundAsp11Onx64 = ret
		Exit Function
	End If
	WorkaroundAsp11Onx64 = 0
End Function

Function ConfigureAccessForPlesk
	Dim ret
	Dim cmd
	LogProgress "Configuring acess for 'PVA Power Panel Plesk Integration Web Site'/vz/cp"
	cmd = fso.GetSpecialFolder(1) & "\inetsrv\appcmd set config " & """" & "PVA Power Panel Plesk Integration Web Site" & """" & "/vz/cp -section:system.webServer/handlers /accessPolicy:Read,Script,Execute"
	ret = ExecuteProcessWow64(".","","",cmd, "appcmd.exe")
	If ret <> 0 Then
		LogError "Failed to set accessPolicy for 'PVA Power Panel Plesk Integration Web Site'/vz/cp"
		ConfigureAccessForPlesk = ret
	End If
	cmd = fso.GetSpecialFolder(1) & "\inetsrv\appcmd set config " & """" & "PVA Power Panel Plesk Integration Web Site" & """" & "/psa -section:system.webServer/handlers /accessPolicy:Read,Script"
	ret = ExecuteProcessWow64(".","","",cmd, "appcmd.exe")
	If ret <> 0 Then
		LogError "Failed to set accessPolicy for 'PVA Power Panel Plesk Integration Web Site'/psa"
		ConfigureAccessForPlesk = ret
	End If
	cmd = fso.GetSpecialFolder(1) & "\inetsrv\appcmd set config " & """" & "PVA Power Panel Plesk Integration Web Site" & """" & "/vz -section:system.webServer/handlers /accessPolicy:Read,Script"
	ret = ExecuteProcessWow64(".","","",cmd, "appcmd.exe")
	If ret <> 0 Then
		LogError "Failed to set accessPolicy for 'PVA Power Panel Plesk Integration Web Site'/vz"
		ConfigureAccessForPlesk = ret
	End If
	ConfigureAccessForPlesk = 0
End Function

Function PostInstall
	Dim ret
	Dim cmd
	Dim i
	Dim portsArr : portsArr=Array(1433,1433,1434,1434,4433,4434,443,4646,8443,4643,4648,4645)
	Dim portNamesArr : portNamesArr = Array("ms-sql-s TCP","ms-sql-s UDP","ms-sql-m TCP","ms-sql-m UDP","VZAgent TCP","VZAgent 1 TCP","VZCP","VZAgent SOAP","VZCP Plesk","VZCP Secure 1", "VZCP Secure 2", "VZCP Redirect")
	Dim portProtocols : portProtocols = Array("TCP","UDP","TCP","UDP","TCP","TCP","TCP","TCP","TCP","TCP","TCP","TCP")
	If GetOS = 6 Then
		ret = ExecuteProcessWow64(".", "", "", "netsh advfirewall firewall set rule group=""@FirewallAPI.dll,-28502"" new enable=Yes", "netsh.exe")
		If ret <> 0 Then
			LogError "Failed to add Windows firewall rules"
			PostInstall = ret
			Exit Function
		End If
		For i = 0 to UBound(portsArr)
			LogProgress vbTab & "Configuring firewall, opening port " & portProtocols(i) & ", rule " & portNamesArr(i)
			ret = ExecuteProcessWow64(".", "", "", "netsh firewall add portopening " & portProtocols(i) & " " & portsArr(i) & " " & """" & portNamesArr(i) & """" & " ENABLE ALL", "netsh.exe")
			If ret <> 0 Then
				LogError "Failed to add windows firewall exception for port: " & portNamesArr(i)
				PostInstall = ret
				Exit Function
			End If
		Next
		cmd = fso.GetSpecialFolder(1) & "\inetsrv\appcmd add apppool /name:" & """" & "ASP.NET 1.1" & """" & " /managedRuntimeVersion:" & """" & "v1.1" & """" & " /managedPipelineMode:Classic"
		ret = ExecuteProcessWow64(".","","",cmd, "appcmd.exe")
		If ret <> 0 Then
			cmd = fso.GetSpecialFolder(1) & "\inetsrv\appcmd set apppool " & """" & "ASP.NET 1.1" & """" & " /managedRuntimeVersion:" & """" & "v1.1" & """" & " /managedPipelineMode:Classic"
			ret = ExecuteProcessWow64(".","","",cmd, "appcmd.exe")
			If ret <> 0 Then
				LogError "Failed to install 'ASP.NET 1.1' application pool"
				PostInstall = ret
				Exit Function
			End If
		End If
		cmd = "icacls """ & fso.GetSpecialFolder(0) & "\Microsoft.NET\Framework\v1.1.4322\Temporary ASP.NET Files"" /grant ""IIS APPPOOL\ASP.NET 1.1"":F /T"
		ret = ExecuteProcessWow64(".","","",cmd, "icacls.exe")
		If ret <> 0 Then
			LogError "Failed to set permissions on the ASP.NET temporary folder"
			PostInstall = ret
			Exit Function
		End If
	End If
	ret = RunConfigurator("PostInstall")
	If ret <> 0 Then
		LogError "Postinstall configuration failed"
		PostInstall = ret
		Exit Function
	End If
	If GetOS = 6 Then
		If Detect64 Then
			LogProgress "Workarounding ASP.NET 1.1 on W2K8 x64"
			If WorkaroundAsp11Onx64 <> 0 Then
				LogError "Failed to workaround http://blogs.iis.net/wonyoo/archive/2009/06/18/workaround-running-asp-net-1-1-on-vista-sp2-ws08-sp2.aspx"
				PostInstall = ret
				Exit Function
			End If
		End If
		PostInstall = ConfigureAccessForPlesk
	End If
End Function

Function PostUpgrade
	Dim ret
	ret = RunConfigurator("PostUpgrade")
	If ret <> 0 Then
		LogError "Postupgrade configuration failed"
		PostUpgrade = ret
	End If
	If GetOS = 6 Then
		PostUpgrade = ConfigureAccessForPlesk
	End If
End Function

Function PostUninstall
	Dim ret
	ret = RunConfigurator("PostUninstall")
	If ret <> 0 Then
		LogError "Postuninstall configuration failed"
		PostUninstall = ret
	End If
End Function
