Option Explicit
' ***********
' Collection of common used VB functions
' ***********

Dim PROG_NAME, PROG_ARGUMENTS

' Define common constants
const PVA_SQL_USER = "vzagent"
const PVA_SERVICE_NAME_SLAVE = "pvaagent"
const PVA_DISPLAY_SERVICE_NAME_SLAVE = "PVA Agent"
const PVA_SERVICE_DESCRIPTION_SLAVE = "Parallels Virtual Automation Agent"
const PVA_TCP_PORT_SLAVE = 4433
const PVA_SSL_PORT_SLAVE = 4434
const PVA_SERVICE_NAME_MASTER = "pvamn"
const PVA_DISPLAY_SERVICE_NAME_MASTER = "PVA Management Server"
const PVA_SERVICE_DESCRIPTION_MASTER = "Parallels Virtual Automation Management Server"
const PVA_TCP_PORT_MASTER = 4533
const PVA_SSL_PORT_MASTER = 4534
const PVA_SQL_INSTANCE_NAME = "PVAAGENT"
const PVA_40_45_UPGRADE_FOLDER = "PVA_40_45_UPGRADE_FOLDER"
const PVA_LOG_ROTATE_TASK_NAME = "PVA Log Rotate"
' All known Virtuozzo cluster states
const PVA_CS_STANDALONE = 1
const PVA_CS_STANDBY = 2
const PVA_CS_ACTIVE = 3
Dim PVA_SQL_SERVER_NAME, PVA_SQL_SERVICE_NAME
PVA_SQL_SERVER_NAME = "(local)\" & PVA_SQL_INSTANCE_NAME
PVA_SQL_SERVICE_NAME = "MSSQL$" & PVA_SQL_INSTANCE_NAME

const MSSQL_REG_TOOLS_PATH = "HKLM\Software\Microsoft\Microsoft SQL Server\90\Tools\ClientSetup\SQLPath"
const MSSQL_REG_TOOLS_PATH_64 = "HKLM\Software\Wow6432Node\Microsoft\Microsoft SQL Server\90\Tools\ClientSetup\SQLPath"
const MSSQL_REG_KEY = "HKLM\Software\Microsoft\Microsoft SQL Server\"
const MSSQL_REG_KEY64 = "HKLM\Software\Wow6432Node\Microsoft\Microsoft SQL Server\"
Dim MSSQL_REGPATH_64
MSSQL_REGPATH_64 = "HKLM\SOFTWARE\Wow6432Node\Microsoft\Microsoft SQL Server\" & PVA_SQL_INSTANCE_NAME & "\Setup\SQLPath"

const DEFAULT_EID = "00000000-0000-0000-0000-000000000002"
const PVA_TCP_PORT_PLACEHOLDER = "PVA_TCP_PORT"
const PVA_SSL_PORT_PLACEHOLDER = "PVA_SSL_PORT"

' Well-known sids (http://support.microsoft.com/kb/243330)
const WELL_SID_ADMINS = "S-1-5-32-544"
const WELL_SID_POWER_USERS = "S-1-5-32-547"
const PVA_SERVICE_NOT_FOUND_ERROR = -10

const PVA_AGENT_VZ_DISTRIBUTION_MSI = "pva-agent-vz-distribution.msi"

Dim DEBUG_OUTPUT
DEBUG_OUTPUT = 1
Dim REPLACE_PATTERN

Dim AGENT_BINARY, OS_ARCH, DATA_FOLDER, ETC_FOLDER, LOGS_FOLDER, INSTALL_FOLDER
Dim VZ_INSTALL_FOLDER, VZ_CLUSTER_STATE, DB_SCRIPTS_FOLDER

' String helper functions
Function TrimRight(str, symbol)
	Dim l
	l = Len(symbol)
	Do While Right(str, l) = symbol
        	str = Left(str, Len(str) - l)
	Loop
	TrimRight = str
End Function

Function TrimLeft(str, symbol)
    Do While Left(str, 1) = symbol
        str = Right(str, Len(str) - 1)
    Loop
	TrimLeft = str
End Function

Function TrimSlashes(str)
	TrimSlashes = TrimRight(str, "\")
End Function

Function TrimSpaces(str)
	TrimSpaces = TrimLeft(TrimRight(str, " "), " ")
End Function

Function TrimNewString(str)
	Dim o
	o = TrimRight(str, vbLf)
	o = TrimRight(o, vbCr)
	TrimNewString = TrimRight(o, vbCrlf)
End Function

Sub AddToPath(str)
	Set shell = CreateObject("WSCript.Shell")
	Set WshSysEnv = shell.Environment("SYSTEM")
	WshSysEnv("PATH") = WshSysEnv("PATH") & str
end sub

function DirName(str)
	DirName = Mid(str, 1, InStrRev(str, "\"))
end function


' Logging and error functions
Sub LogProgress(msg)
	If Len(REPLACE_PATTERN) Then
		msg = Replace(msg, REPLACE_PATTERN, "******")
	End If
	If LCase(Right(Wscript.fullname,11)) = "cscript.exe" Then
		Dim CurTime
		CurTime = Now
		WScript.StdOut.WriteLine(Date & " " & Hour(CurTime) & ":" & Minute(CurTime) & ":" & Second(CurTime) & vbTab & msg)
	End If
End Sub

Sub LogError(code, msg)
	If Len(REPLACE_PATTERN) Then
		msg = Replace(msg, REPLACE_PATTERN, "******")
	End If
	If LCase(Right(Wscript.fullname,11)) = "cscript.exe" Then
		WScript.StdErr.WriteLine("ERROR [" & code & "]: " & msg)
	Else
		MsgBox "ERROR [" & code & "]: " & msg, vbCritical, "VZTools configuration engine"
	End If
	
	Err.Clear
End Sub

Function FailedQuit(msg)
	LogError -1, msg
	WScript.Quit -1
End Function

Function FailedQuitEx(number, msg)
	LogError number, msg
	WScript.Quit number
End Function

Function FailedQuitErr(msg)
	FailedQuitEx Err.number, msg & " - " & Err.source & ", " & Err.Description
End Function

' 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
	
	If DEBUG_OUTPUT Then 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	FailedQuitErr "Failed to write registry value '" & value & "' to key '" & key & "'"
End Sub

Sub DeleteRegistryKey(key)
	On Error Resume Next
	
	If DEBUG_OUTPUT Then LogProgress vbTab & "Deleting registry key '" & key & "'"
	
	Dim wso
	Set wso=CreateObject ("WSCript.Shell")	
	wso.RegDelete key
	If Err.Number <> 0 Then	LogError Err.Number, "Failed to delete registry key '" & key & "'"
End Sub

' Base 64 functions
Function Base64Decode(ByVal base64String)
  Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
  Dim dataLength, sOut, groupBegin
  
  base64String = Replace(base64String, vbCrLf, "")
  base64String = Replace(base64String, vbTab, "")
  base64String = Replace(base64String, " ", "")
  
  dataLength = Len(base64String)
  If dataLength Mod 4 <> 0 Then
    Err.Raise 1, "Base64Decode", "Bad Base64 string."
    Exit Function
  End If

  For groupBegin = 1 To dataLength Step 4
    Dim numDataBytes, CharCounter, thisChar, thisData, nGroup, pOut
    numDataBytes = 3
    nGroup = 0

    For CharCounter = 0 To 3

      thisChar = Mid(base64String, groupBegin + CharCounter, 1)

      If thisChar = "=" Then
        numDataBytes = numDataBytes - 1
        thisData = 0
      Else
        thisData = InStr(1, Base64, thisChar, vbBinaryCompare) - 1
      End If
      If thisData = -1 Then
        Err.Raise 2, "Base64Decode", "Bad character In Base64 string."
        Exit Function
      End If

      nGroup = 64 * nGroup + thisData
    Next
    
    nGroup = Hex(nGroup)
    
    nGroup = String(6 - Len(nGroup), "0") & nGroup
    
    pOut = Chr(CByte("&H" & Mid(nGroup, 1, 2))) + _
      Chr(CByte("&H" & Mid(nGroup, 3, 2))) + _
      Chr(CByte("&H" & Mid(nGroup, 5, 2)))
    
    sOut = sOut & Left(pOut, numDataBytes)
  Next

  Base64Decode = sOut
End Function

Function Base64Encode(inData)
  Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
  Dim cOut, sOut, I
  
  For I = 1 To Len(inData) Step 3
    Dim nGroup, pOut, sGroup
    
    nGroup = &H10000 * Asc(Mid(inData, I, 1)) + _
      &H100 * MyASC(Mid(inData, I + 1, 1)) + MyASC(Mid(inData, I + 2, 1))

    nGroup = Oct(nGroup)
    nGroup = String(8 - Len(nGroup), "0") & nGroup
    
    pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + _
      Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + _
      Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + _
      Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)
    
    sOut = sOut + pOut
  Next
  Select Case Len(inData) Mod 3
    Case 1:
      sOut = Left(sOut, Len(sOut) - 2) + "=="
    Case 2:
      sOut = Left(sOut, Len(sOut) - 1) + "="
  End Select
  Base64Encode = sOut
End Function

Function MyASC(OneChar)
  If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)
End Function

' File support functions
Function ReadFromFile(FilePath)
	Dim oFS, oFile
	Set oFS = CreateObject("Scripting.Filesystemobject")
	Set oFile = oFS.OpenTextFile(FilePath)
	ReadFromFile = oFile.ReadAll()
	oFile.Close
End Function

Sub WriteToFileEx(FilePath, StrData, Append)
	On Error Resume Next
	Dim oFS, oFile
	Set oFS = CreateObject("Scripting.Filesystemobject")
	If Append Then
		Set oFile = oFS.OpenTextFile(FilePath, 8, true)
	Else
		Set oFile = oFS.OpenTextFile(FilePath, 2, true)
	End If
	oFile.Write StrData
	
	If Err.Number <> 0 Then	FailedQuitErr "Failed to write '" & filePath & "'"
End Sub

Sub WriteToFile(FilePath, StrData)
	WriteToFileEx FilePath, StrData, False
End Sub

Sub ReplaceInFile(srcFile, strFind, strReplace)
	ReplaceInFileEx srcFile, srcFile, strFind, strReplace
End Sub

Function GetTempFolder
	Dim tfolder, fso
	Set fso = CreateObject("Scripting.FileSystemObject")
	Const TemporaryFolder = 2
	Set tfolder = fso.GetSpecialFolder(TemporaryFolder)
	GetTempFolder = tfolder.Path
End Function

Sub ReplaceInFileEx(srcFile, destFile, strFind, strReplace)
	On Error Resume Next
	
	Dim str
	str = ReadFromFile(srcFile)
	
	If Err.number <> 0 Then	FailedQuitErr "Failed to read '" & srcFile & "'"
	
	str = Replace(str, strFind, strReplace)
	
	WriteToFile destFile, str
End Sub

Sub DeleteFile(file)
	On Error Resume Next
	Dim objFSO
	Set objFSO = CreateObject("Scripting.FileSystemObject")

	If objFSO.FileExists(file) Then
		If DEBUG_OUTPUT Then
			LogProgress vbTab & "Deleting file " & file
		End If
		objFSO.DeleteFile file, true
		If Err.number <> 0 Then FailedQuitErr "Failed to delete file '" & file & "'"
	End If
End Sub

' Folder functions
Sub DeleteFolder(folder)
	On Error Resume Next
	Dim objFSO
	Set objFSO = CreateObject("Scripting.FileSystemObject")

	If objFSO.FolderExists(folder) Then
		If DEBUG_OUTPUT Then
			LogProgress vbTab & "Deleting folder " & folder
		End If
		objFSO.DeleteFolder(folder)
		If Err.number <> 0 Then FailedQuitErr "Failed to delete folder '" & folder & "'"
	End If
End Sub

' Folder functions
Sub DeleteFolderSafe(folder)
	On Error Resume Next
	Dim objFSO
	Set objFSO = CreateObject("Scripting.FileSystemObject")

	If objFSO.FolderExists(folder) Then
		If DEBUG_OUTPUT Then
			LogProgress vbTab & "Deleting folder " & folder
		End If
		objFSO.DeleteFolder(folder)
		If Err.number <> 0 Then LogError Err.number, "Failed to delete folder '" & folder & "'"
	End If
End Sub

Sub CreateFolder(folder)
	On Error Resume Next
	Dim objFSO
	Set objFSO = CreateObject("Scripting.FileSystemObject")

	If Not objFSO.FolderExists(folder) Then
		If DEBUG_OUTPUT Then
			LogProgress vbTab & "Creating folder " & folder
		End If
		objFSO.CreateFolder(folder)
		If Err.number <> 0 Then FailedQuitErr "Failed to create folder '" & folder & "'"
	End If
End Sub

Sub CreateFolderRecursive(folder)
	On Error Resume Next
	Dim objFSO
	Set objFSO = CreateObject("Scripting.FileSystemObject")

	Dim parentFolder
	parentFolder = objFSO.GetParentFolderName(folder)
	If Not objFSO.FolderExists(parentFolder) Then CreateFolderRecursive parentFolder
	CreateFolder folder
End Sub

Sub CopyFolder(srcFolder, destFolder)
	On Error Resume Next
	Dim objFSO
	If DEBUG_OUTPUT Then
		LogProgress vbTab & "Copying " & srcFolder & " to " & destFolder
	End If
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	objFSO.CopyFolder srcFolder, destFolder, 1
		
End Sub

Sub CopyFile(src, dest)
	On Error Resume Next
	Dim objFSO
	If DEBUG_OUTPUT Then
		LogProgress vbTab & "Copying " & src & " to " & dest
	End If
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	objFSO.CopyFile src, dest, 1
		
End Sub


' Add user

Function GetGroupNameBySID(sGroupSID)
	' List of well know SID's is available here:
	' Well-known security identifiers in Windows operating systems
	' http://support.microsoft.com/?id=243330	
	
	Dim oNetwork
	Set oNetwork = CreateObject("WScript.Network")
	
	Dim oGroupAccounts
	Set oGroupAccounts = GetObject("winmgmts://" & oNetwork.ComputerName & "/root/cimv2") _
						.ExecQuery("Select Name from Win32_Group WHERE Domain = '" & oNetwork.ComputerName & "' AND SID = '" & sGroupSID & "'")

	If oGroupAccounts.Count = 0 Then
		' need to use Domain = 'BUILTIN' at least for Win2k SP2
		Set oGroupAccounts = GetObject( _
			"winmgmts://" & oNetwork.ComputerName & "/root/cimv2") _
			.ExecQuery("Select Name from Win32_Group" _
			& " WHERE Domain = 'BUILTIN' AND SID = '" & sGroupSID & "'")
	End If

	GetGroupNameBySID = ""
	Dim oGroupAccount
	For Each oGroupAccount In oGroupAccounts
		GetGroupNameBySID = oGroupAccount.Name
	Next
End Function

Function GetAdministratorsGroupName
	GetAdministratorsGroupName = GetGroupNameBySID(WELL_SID_ADMINS)
End Function

Function GetAdministratorName
	On Error Resume Next
	
	Dim oNetwork, strComputer
	Set oNetwork = CreateObject("WScript.Network")
	strComputer = oNetwork.ComputerName
		
	LogProgress "Getting built-in account for administering " & strComputer
	
	Dim oWMI, oUserAccounts, oUserAccount
	Set oWMI = GetObject("winmgmts://" & oNetwork.ComputerName & "/root/cimv2")
	If Err.number <> 0 Then FailedQuitEx Err.number, "Failed to GetObject ""winmgmts://" & oNetwork.ComputerName & "/root/cimv2"""
	
	Set oUserAccounts =  oWMI.ExecQuery("Select Name, SID from Win32_UserAccount WHERE Domain = '" & oNetwork.ComputerName & "'")
	If Err.number <> 0 Then FailedQuitEx Err.number, "Failed to ExecQuery ""Select Name, SID from Win32_UserAccount WHERE Domain = '" & oNetwork.ComputerName & "'"""

	LogProgress "Found " & oUserAccounts.Count & " user accounts"
	For Each oUserAccount In oUserAccounts
		LogProgress vbTab & "Checking account '" & oUserAccount.Name & "'"
		LogProgress vbTab & vbTab  & "its SID is " & oUserAccount.SID
		If Left(oUserAccount.SID, 9) = "S-1-5-21-" And Right(oUserAccount.SID, 4) = "-500" Then
			LogProgress vbTab & "Accoung '" & oUserAccount.Name & "' is the required one"
			GetAdministratorName = oUserAccount.Name
			Exit Function
		End if
	Next
	
	FailedQuit "Failed to get built-in account for administering the computer/domain"
	
End Function

Sub DisableUser(strUser)
	Dim oNet, oUser
	Set oNet = CreateObject("WScript.Network")
	
	LogProgress("Disabling user '" & strUser & "'")
	
	Set	oUser = GetObject("WinNT://" & oNet.ComputerName & "/" & strUser & ",user")
	oUser.AccountDisabled = TRUE
	oUser.SetInfo
End Sub

Sub AddUser(strUser,strPassword)
	On Error Resume Next

	LogProgress("Adding user '" & strUser & "'")
	
	If DEBUG_OUTPUT Then
		LogProgress(vbTab & "AddUser(" & strUser & "," & strPassword & ")")
	End If
							
	Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
	Const ERR_VB_USER_ALREADY_EXISTS = -2147022672
	
	Err.Clear
	
	Dim oNet, oComputer, oUser
	Set oNet = CreateObject("WScript.Network")
	Set oComputer = GetObject("WinNT://" & oNet.ComputerName)
	Set oUser = oComputer.create("User",strUser)
	If Err.Number <> 0 And Err.Number <> ERR_VB_USER_ALREADY_EXISTS Then FailedQuitErr "Failed to add user '" & strUser & "'"

	oUser.SetPassword(strPassword)
	oUser.SetInfo
	Err.Clear
			
	Set	oUser = GetObject("WinNT://" & oNet.ComputerName & "/" & strUser & ",user")	
	oUser.SetPassword(strPassword)
	oUser.SetInfo
	If Err.Number <> 0 Then	FailedQuitErr "Failed to set user '" & strUser & "' password"

	' Set password to never expire
	Dim UserFlags
	UserFlags = oUser.Get("UserFlags")
	oUser.Put "UserFlags", UserFlags Or ADS_UF_DONT_EXPIRE_PASSWD
	oUser.SetInfo

	If Err.Number <> 0 Then	FailedQuitErr "Failed to set user '" & strUser & "' info"
End Sub

Sub AddUserToAdminsGroup(strUser)
	' Get Administrators group name by whell-known SID
	Dim adminsGroupName
	adminsGroupName = GetAdministratorsGroupName
	If adminsGroupName = "" Then FailedQuit "Failed to get Administrators group name - " & Err.Description
	
	AddUserToGroup strUser, adminsGroupName
End Sub

Sub AddUserToGroup(strUser, strGroup)
	On Error Resume Next
	' Add to administrator group

	If DEBUG_OUTPUT Then
		LogProgress(vbTab & "AddUserToGroup(" & strUser & "," & strGroup & ")")
	End If
	
	Dim oGroup, oNet, oUser
	Set oNet = CreateObject("WScript.Network")
	Set	oUser = GetObject("WinNT://" & oNet.ComputerName & "/" & strUser & ",user")	
	
	Const ERR_VB_USER_ALREADY_IN_GROUP = -2147023518
	Set oGroup = GetObject("WinNT://" & oNet.ComputerName & "/" & strGroup & ",group")	
	oGroup.Add(oUser.ADsPath)
	
	If Err.Number <> 0 and Err.Number <> ERR_VB_USER_ALREADY_IN_GROUP Then FailedQuitErr "Failed to add user '" & strUser & "' to group '" & strGroup & "'"
End Sub

Sub DeleteUser(strUser)
	ON ERROR RESUME NEXT
	Set oNet = CreateObject("WScript.Network")
	Set Computer = Getobject("WinNT://" & oNet.ComputerName)
	Computer.Delete "User", strUser
End Sub

Sub ChangeUserPassword(strUser,strPassword)
	Set oNet = CreateObject("WScript.Network")
	Set oUser = GetObject("WinNT://" & oNet.ComputerName & "/" & strUser & ",user")
	Call oUser.SetPassword(strPassword)
	oUser.SetInfo
End sub

Sub RunCommand(command)
	Dim out, err, ret
	ret = ExecProgram(command, "", out, err)
		
	If ret <> 0 Then
		FailedQuitEx ret, "Failed to exec '" & command & "'" & vbCrlf & out & err
	End If
	LogProgress out
End Sub

Sub RunCommandWithoutCheck(command)
	Dim out, err, ret
	ret = ExecProgram(command, "", out, err)
End Sub

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

	If DEBUG_OUTPUT Then
		LogProgress vbTab & "Executing '" & cmd & "'"
	End If
		
	Dim wso
	Set wso = CreateObject ("WSCript.Shell")
	
	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 

' Network drives functions
Sub MapRemoteComp(letter, address, user, password )
	On Error Resume Next
	Dim objNetwork

	Wscript.Echo "Map remote comp '" & address & "'"	
	
	Set objNetwork = WScript.CreateObject("WScript.Network")
	objNetwork.RemoveNetworkDrive letter
	' Ignore Error
	Err.Clear
	objNetwork.MapNetworkDrive letter, "\\" & address & "\C$", false, user, password
	If Err.Number <> 0 Then FailedQuitErr "Failed to map share"
End Sub

Sub UnmapRemoteComp(letter)
	Dim objNetwork
	Wscript.Echo "Unmap remote comp"	
	Set objNetwork = WScript.CreateObject("WScript.Network")
	objNetwork.RemoveNetworkDrive letter	
End Sub

' Service functions
Sub UnregisterService(name)
	On Error Resume Next
	Dim Locator, Services, ServiceObject

	Set Locator = CreateObject("WbemScripting.SWbemLocator")
	Set Services = Locator.ConnectServer(".")
	Set ServiceObject = Services.Get("Win32_Service='" & name & "'")
	If Err.Number=0 Then
		LogProgress "Deleting service '" & name & "'"
		Dim ret
		ret = ServiceObject.Delete
		If ret <> 0 Then
			LogError ret, "Failed to delete service '" & name & "'"
		End If
	Else
		LogError Err.number, "Failed to find service '" & name & "'"
	End If
End Sub

Sub RegisterService(name, display_name, description, bin, user, password, dependencies)
	On Error Resume Next
	
	Dim Locator, Services, Service, ret

	LogProgress "Creating service '" & name & "'"

	Const OWN_PROCESS = 16
	Const NOT_INTERACTIVE = False
	Const NORMAL_ERROR_CONTROL = 1
	Const COMPUTER = "."
	
	Set Locator = CreateObject("WbemScripting.SWbemLocator")
	If Err.number <> 0 Then FailedQuitEx Err.number, "Failed to create object WbemScripting.SWbemLocator - " & Err.Description
	
	Set Services = Locator.ConnectServer(".")
	If Err.number <> 0 Then FailedQuitEx Err.number, "Failed to connect SWbemLocator to local server - " & Err.Description
	
	Set Service = Services.Get("Win32_Service='" & name & "'")

	Dim StartAsName
	If user Then
		StartAsName = COMPUTER & "\" & user
	Else
		StartAsName = Null
	End If
	If Err.number <> 0 Then
		Dim BaseService, StartAs
		Set BaseService = Services.Get("Win32_BaseService")

		ret = BaseService.Create(name, display_name, bin, OWN_PROCESS, NORMAL_ERROR_CONTROL, "Automatic", NOT_INTERACTIVE, StartAsName, password, Null, Null, dependencies)
		If ret <> 0 Then FailedQuitErr "Failed to create service '" & name & "'"

	Else

		LogProgress "Service '" & name & "' allready exists. Changing service"

		ret = Service.Change(display_name, bin, OWN_PROCESS, NORMAL_ERROR_CONTROL, "Automatic", NOT_INTERACTIVE, StartAsName, password, Null, Null, dependencies)
		If ret <> 0 Then FailedQuitErr "Failed to change service '" & name & "'"
	End If

	' Change service description and failure action(WMI does not provide any way to do it)	
	Const HKEY_LOCAL_MACHINE = &H80000002
	Dim strKeyPath, strValueName, objRegistry
 	Set objRegistry = GetObject("winmgmts:\\" & COMPUTER & "\root\default:StdRegProv")
	strKeyPath = "System\CurrentControlSet\Services\" & name
	strValueName = "Description"
	objRegistry.SetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,description

	RunCommand "sc failure " & name & " reset= INFINITE actions= restart/3000/restart/3000/restart/3000"
End Sub

Sub WaitService(ServiceObject, seconds, state)
	Dim startTime
	startTime = Timer
	Do While (Timer - startTime < seconds) AND (ServiceObject.State <> state)
		WScript.Sleep 1000
		ServiceObject.Refresh_
	Loop
End Sub

Function StopService(name)
	StopService = StopServiceEx(name, "", "", "")
End Function

Function StopServiceEx(name, server, user, password)
	On Error Resume Next
	LogProgress "Stopping service '" & name & "'"

	Dim ServiceObject
	Set ServiceObject = FindServiceEx(name, server, user, password)
	If Err.Number=0 Then
		ServiceObject.StopService

		If Err.number = 0 Then
			WaitService ServiceObject, 1 * 60, "Stopped"
		End If
		If (Err.number <> 0) OR (ServiceObject.State <> "Stopped") Then
			LogError Err.number, "Failed to stop service '" & name & "' (" & ServiceObject.State & ") - " & Err.Description
			StopServiceEx = -1
		Else               
			LogProgress "Successfully stopped service '" & name & "'"
			StopServiceEx = 0
		End If
	Else
		LogProgress vbTab & "Service '" & name & "' was not found"
		StopServiceEx = PVA_SERVICE_NOT_FOUND_ERROR
	End If
End Function

Function StartService(name)
	StartService = StartServiceEx(name, "", "", "")
End Function

Function StartServiceEx(name, server, user, password)
	LogProgress "Starting service '" & name & "'"

	Dim ServiceObject
	Set ServiceObject = FindServiceEx(name, server, user, password)
	If Err.Number=0 Then
		ServiceObject.StartService

		If Err.number = 0 Then
			WaitService ServiceObject, 1 * 60, "Running"
		End If
		If (Err.number <> 0) OR (ServiceObject.State <> "Running") Then
			LogError Err.number, "Failed to start service '" & name & "' (" & ServiceObject.State & ") - " & Err.Description
			StartServiceEx = -1
		Else
			LogProgress "Successfully started service '" & name & "'"
			StartServiceEx = 0
		End If
	Else
		LogProgress vbTab & "Service '" & name & "' was not found"
		StartServiceEx = PVA_SERVICE_NOT_FOUND_ERROR
	End If
End Function

' hosts file functions
Function GetHostAliases(strHostFile,strIP)
	Const fileRead = 1

	Dim objFSO , objFlagFile 
	Dim strLine, arrHostEnteries , strHostAliases, i

	Dim Seps(2)

	strHostAliases = ""

	Seps(0) = " "
	Seps(1) = vbTab 

	Set objFSO = CreateObject("Scripting.FileSystemObject")
	If objFSO.FileExists( strHostFile ) Then
		Set objFlagFile = objFSO.OpenTextFile(strHostFile ,fileRead)
		Do While Not objFlagFile.AtEndOfStream
			strLine = UCase(Trim(objFlagFile.ReadLine))
			If strLine <> "" AND Left(strLine,1) <> "#" Then
				If InStr(strLine, "#") > 0 Then
					strLine = Left(strLine,InStr(strLine, "#") - 1)
				End If
				arrHostEnteries = Tokenize( strLine , Seps )
				If( UBound( arrHostEnteries ) > 0 ) Then
					If arrHostEnteries(0) = UCase(Trim(strIP)) Then
						For i = (LBound( arrHostEnteries ) + 1) _
							To (UBound( arrHostEnteries ) - 1)
							strHostAliases = _
								strHostAliases & arrHostEnteries(i) & " "
						Next 
					End If 
				End If
				End If
		Loop
		objFlagFile.Close
	End If
	
    GetHostAliases = Tokenize( Trim(strHostAliases) , Seps )
End Function

Sub DelHostEntry(strHostFile,strIP)
	Const fileRead = 1
	Const fileWrite = 2
	Const fileAppend = 8
	Const SPACES = 20

	Dim objFSO , objFlagFile
	Dim strLine, strNewHostFile , strNewHostLine, arrHostEnteries, i
	Dim nNameLen
	Dim nAddSpaces

	Dim Seps(2)

	Seps(0) = " "
	Seps(1) = vbTab 

	strNewHostFile = ""
	strNewHostLine = ""

	Set objFSO = CreateObject("Scripting.FileSystemObject")
	If objFSO.FileExists( strHostFile ) Then
	Set objFlagFile = objFSO.OpenTextFile(strHostFile ,fileRead)
	Do While Not objFlagFile.AtEndOfStream
			strLine = UCase(Trim(objFlagFile.ReadLine))
			If strLine <> "" AND Left(strLine,1) <> "#" Then
					arrHostEnteries = Tokenize( strLine , Seps )
				If UBound( arrHostEnteries ) > 0 Then
					If UBound( arrHostEnteries ) = 1 OR arrHostEnteries(0) = _
						UCase(Trim(strIP)) Then ' Check for Aliases and remove it not correct
						strNewHostLine = ""
					Else
						nNameLen = Len(arrHostEnteries(0))
						nAddSpaces = SPACES - nNameLen
						strNewHostLine = arrHostEnteries(0) & Space(nAddSpaces)
						For i = (LBound( arrHostEnteries ) + 1) _
								To (UBound( arrHostEnteries ) - 1)
							strNewHostLine = strNewHostLine & " " & arrHostEnteries(i)
						Next 
					End If
				End If 

				If strNewHostLine <> "" Then
					strNewHostFile = strNewHostFile & strNewHostLine & vbCRLF
			End If
	        
		Else ' Comments and Blank Lines Added Here
				strNewHostLine = strLine
				strNewHostFile = strNewHostFile & strNewHostLine & vbCRLF
		End If
		strNewHostLine = ""
		Loop
		objFlagFile.Close
	End If

	Set objFlagFile = objFSO.OpenTextFile(strHostFile ,fileWrite)
	objFlagFile.Write strNewHostFile
	objFlagFile.Close
End Sub

Sub DelHostAlias(strHostFile,strHost)
	Const fileRead = 1
	Const fileWrite = 2
	Const fileAppend = 8
	Const SPACES = 20

	Dim objFSO , objFlagFile
	Dim strLine, strNewHostFile , strComment, strNewHostLine, arrHostEnteries, i
	Dim Seps(2)

	Dim nNameLen
	Dim nAddSpaces

	Seps(0) = " "
	Seps(1) = vbTab

	strComment = ""
	strNewHostFile = ""
	strNewHostLine = ""

	Set objFSO = CreateObject("Scripting.FileSystemObject")

	If objFSO.FileExists( strHostFile ) Then
	Set objFlagFile = objFSO.OpenTextFile(strHostFile ,fileRead)
	Do While Not objFlagFile.AtEndOfStream
			strLine = UCase(Trim(objFlagFile.ReadLine))
			If strLine <> "" AND Left(strLine,1) <> "#" Then
				If InStr(strLine, "#") > 0 Then
					strComment = " " & Right( strLine , _
						Len( strLine ) - InStr(strLine, "#") + 1 )
					strLine = Left(strLine,InStr(strLine, "#") - 1)
				Else
					strComment = ""
			End If
					arrHostEnteries = Tokenize( strLine , Seps )
					If UBound( arrHostEnteries ) > 0 Then
						nNameLen = Len(arrHostEnteries(0))
					nAddSpaces = SPACES - nNameLen
						strNewHostLine = arrHostEnteries(0) & Space(nAddSpaces)
					If UBound( arrHostEnteries ) = 1 Then
						strNewHostLine = ""
						strComment = ""
					Else
						For i = (LBound( arrHostEnteries ) + 1) _
								To (UBound( arrHostEnteries ) - 1)
							If arrHostEnteries(i) <> UCase(Trim(strHost)) Then
								strNewHostLine = strNewHostLine _
											& " " & arrHostEnteries(i)
							ElseIf UBound( arrHostEnteries ) = 2 Then
								strNewHostLine = ""
								strComment = ""
							End If
							Next 
						End If
				End If 

				If strNewHostLine <> "" Then
					strNewHostFile = strNewHostFile & _
							strNewHostLine & strComment & vbCRLF
			End If

		Else ' Comments and Blank Lines Added Here
				strNewHostLine = strLine
				strNewHostFile = strNewHostFile & strNewHostLine & vbCRLF
		End If
		strNewHostLine = ""
		Loop
		objFlagFile.Close
	End If

	Set objFlagFile = objFSO.OpenTextFile(strHostFile ,fileWrite)
	objFlagFile.Write strNewHostFile
	objFlagFile.Close

End Sub

Sub AddHostAlias(strHostFile,strHost,strIP)
	Const fileRead = 1
	Const fileWrite = 2
	Const fileAppend = 8
	Const SPACES = 20
	
	If DEBUG_OUTPUT Then LogProgress "Adding host alias (" & strHostFile & ", " & strHost & ", " & strIP & ")"

	Dim objFSO , objFlagFile
	Dim strLine, strHostEntry, strNewHostFile , strNewHostLine, _
	strComment, bFound, bOmitRemainder, arrHostEnteries, i
	Dim Seps(2)

	Dim nNameLen
	Dim nAddSpaces

	Seps(0) = " "
	Seps(1) = vbTab 

	bFound = False
	bOmitRemainder = False

	strComment = ""
	strNewHostFile = ""
	strNewHostLine = ""

	Set objFSO = CreateObject("Scripting.FileSystemObject")

	If objFSO.FileExists( strHostFile ) Then
	
	Set objFlagFile = objFSO.OpenTextFile(strHostFile ,fileRead)
	Do While Not objFlagFile.AtEndOfStream
		strLine = UCase(Trim(objFlagFile.ReadLine))
		If strLine <> "" AND Left(strLine,1) <> "#" Then
			If InStr(strLine, "#") > 0 Then
				strComment = " " & Right( strLine , _
					Len( strLine ) - InStr(strLine, "#") + 1 )
				strLine = Left(strLine,InStr(strLine, "#") - 1)
			Else
				strComment = ""
			End If
			arrHostEnteries = Tokenize( strLine , Seps )
			If UBound( arrHostEnteries ) > 0 Then
				nNameLen = Len(arrHostEnteries(0))
				nAddSpaces = SPACES - nNameLen
				If nAddSpaces < 0 Then nAddSpaces = 0
				strNewHostLine = arrHostEnteries(0) & Space(nAddSpaces)
				If arrHostEnteries(0) = UCase(Trim(strIP)) Then
				'Check the entries for certain IP...
					For i = (LBound( arrHostEnteries ) + 1) _
							To (UBound( arrHostEnteries ) - 1)
						If arrHostEnteries(i) = UCase(Trim(strHost)) Then
							bFound    = True
							strNewHostLine = strNewHostLine _
									& " " & UCase(Trim(strHost))
						Else
							strNewHostLine = strNewHostLine _
									& " " & arrHostEnteries(i)
						End If
					Next

					If Not bFound Then
						strNewHostLine = strNewHostLine _
								& " " & UCase(Trim(strHost))
						bFound = True
					End If

				Else 'Check if it exist in different IP ranges and remove them
					If UBound( arrHostEnteries ) = 1 Then
						strNewHostLine = ""
						strComment = ""
					Else
						For i = (LBound( arrHostEnteries ) + 1) _
								To (UBound( arrHostEnteries ) - 1)
							If arrHostEnteries(i) <> UCase(Trim(strHost)) Then
								strNewHostLine = strNewHostLine _
										& " " & arrHostEnteries(i)
							ElseIf UBound( arrHostEnteries ) = 2 Then
								strNewHostLine = ""
								strComment = ""
							End If
							Next 
						End If
				End If 
			End If 
			If strNewHostLine <> "" Then
				strNewHostFile = strNewHostFile & _
						strNewHostLine & strComment & vbCRLF
		End If
		Else ' Comments and Blank Lines Added Here
			strNewHostLine = strLine
			strNewHostFile = strNewHostFile & strNewHostLine & vbCRLF
	End If
	strNewHostLine = ""
	Loop
	objFlagFile.Close

	If Not bFound Then
		strNewHostLine = UCase(Trim(strIP)) & "       "_
					& UCase(Trim(strHost)) & vbCRLF
		strNewHostFile = strNewHostFile & strNewHostLine
	End If 

	Else ' File doesn't exist so create it and write
		strNewHostFile = UCase(Trim(strIP)) & _
				"       " & UCase(Trim(strHost)) 
	End If

	Dim fileToSave
	Set fileToSave = objFSO.GetFile(strHostFile)
	If fileToSave.Attributes AND 1 Then
		fileToSave.Attributes = fileToSave.Attributes - 1
		Set objFlagFile = objFSO.OpenTextFile(strHostFile ,fileWrite)
		objFlagFile.Write strNewHostFile
		objFlagFile.Close
		fileToSave.Attributes = fileToSave.Attributes + 1
	Else
		Set objFlagFile = objFSO.OpenTextFile(strHostFile ,fileWrite)
		objFlagFile.Write strNewHostFile
		objFlagFile.Close
	End If
End Sub

Sub EnableFirewallBypass(imagePath, appName)
	On Error Resume Next

	Dim osVersion
	osVersion = GetOsVersion

	If osVersion < "6.0" Then
		EnableFirewallBypassWin2003 imagePath, appName
	Else
		EnableFirewallBypassWin2008 imagePath, appName
	End If
End Sub

Sub EnableFirewallBypassWin2003(imagePath, appName)
	On Error Resume Next
	
	LogProgress "Creating program firewall exception for " & imagePath
	'best practices: http://msdn2.microsoft.com/en-us/library/aa366421.aspx
	Const NET_FW_SCOPE_ALL = 0
	Const NET_FW_IP_VERSION_ANY = 2

	Dim fwMgr
	Set fwMgr = CreateObject("HNetCfg.FwMgr")
	If Err.number <> 0 Then	FailedQuitErr Err, "Failed to create firewall manager"

	Dim profile
	Set profile = fwMgr.LocalPolicy.CurrentProfile
	If Err.Number = 0 Then

		Dim appVZAgent
		Set appVZAgent = CreateObject("HNetCfg.FwAuthorizedApplication")
		If Err.number <> 0 Then	FailedQuitErr Err, "Failed to create authorized application"

		appVZAgent.ProcessImageFileName = imagePath
		appVZAgent.Name = appName
		appVZAgent.Scope = NET_FW_SCOPE_ALL
		appVZAgent.IpVersion = NET_FW_IP_VERSION_ANY
		appVZAgent.Enabled = TRUE

		profile.AuthorizedApplications.Add appVZAgent
		If Err.number <> 0 Then	FailedQuitErr Err, "Failed to create program exception for " & imagePath
		LogProgress "Program firewall exception created succesfully"
	Else
		LogError Err.number, "Failed to create profile property. Probably firewall service is not running."
	End If
End Sub

Sub EnableFirewallBypassWin2008(imagePath, appName)
	On Error Resume Next

	LogProgress "Creating program firewall exception for " & imagePath
	'best practices: http://social.msdn.microsoft.com/Forums/de-DE/3f0d73cd-130b-4c7f-979f-77a4ee4c36c2/no-way-to-programmatically-configure-firewall-in-the-new-public-network-profile
	Const NET_FW_SCOPE_ALL = 0
	Const NET_FW_IP_VERSION_ANY = 2
	Const NET_FW_ACTION_ALLOW = 1

	Dim fwPolicy
	Set fwPolicy = CreateObject("HNetCfg.FwPolicy2")
	If Err.number <> 0 Then FailedQuitErr Err, "Failed to create firewall policy"

	Dim fwRule
	Set fwRule = CreateObject("HNetCfg.FWRule")
	If Err.number <> 0 Then FailedQuitErr Err, "Failed to create firewall rule"

	fwRule.Action = NET_FW_ACTION_ALLOW
	fwRule.ApplicationName = imagePath
	fwRule.Enabled = True
	fwRule.InterfaceTypes = "All"
	fwRule.Name = appName

	fwPolicy.Rules.Add(fwRule)
	If Err.number <> 0 Then FailedQuitErr Err, "Failed to add program exception for " & imagePath

	LogProgress "Program firewall exception created succesfully"
End Sub

Sub DisableFirewallBypass(imagePath)
	On Error Resume Next
	
	LogProgress "Removing program firewall exception for " & imagePath

	Dim fwMgr, profile
	Set fwMgr = CreateObject("HNetCfg.FwMgr")
	If Err.number <> 0 Then	FailedQuitErr Err, "Failed to create firewall manager"

	Set profile = fwMgr.LocalPolicy.CurrentProfile
	If Err.Number = 0 Then
		profile.AuthorizedApplications.Remove imagePath
		If Err.number <> 0 Then	FailedQuitErr Err, "Failed to remove program exception for " & imagePath
		LogProgress "Program firewall exception removed succesfully"
	Else
		LogError Err.number, "Failed to create profile property. Probably firewall service is not running."
	End If
End Sub

Function Tokenize(byVal TokenString, byRef TokenSeparators())

    Dim NumWords, a(), i
    NumWords = 0

    Dim NumSeps
    NumSeps = UBound(TokenSeparators)

    Do 
        Dim SepIndex, SepPosition
        SepPosition = 0
        SepIndex    = -1

        for i = 0 to NumSeps-1

            ' Find location of separator in the string
            Dim pos
            pos = InStr(TokenString, TokenSeparators(i))

            ' Is the separator present, and is it closest
            ' to the beginning of the string?
            If pos > 0 and ( (SepPosition = 0) or _
                     (pos < SepPosition) ) Then
                SepPosition = pos
                SepIndex    = i
            End If

        Next

        ' Did we find any separators?
        If SepIndex < 0 Then

            ' None found - so the token is the remaining string
            redim preserve a(NumWords+1)
            a(NumWords) = TokenString

        Else

            ' Found a token - pull out the substring
            Dim substr
            substr = Trim(Left(TokenString, SepPosition-1))

            ' Add the token to the list
            redim preserve a(NumWords+1)
            a(NumWords) = substr

            ' Cutoff the token we just found
            Dim TrimPosition
            TrimPosition = SepPosition+Len(TokenSeparators(SepIndex))
            TokenString = Trim(Mid(TokenString, TrimPosition))

        End If    

        NumWords = NumWords + 1
    loop while (SepIndex >= 0)

    Tokenize = a

End Function

Function GetRegistryKey
	If PVA_MN_CORE = 1 Then
		GetRegistryKey = "HKEY_LOCAL_MACHINE\SOFTWARE\Parallels\PVA\mn\"
	Else
		GetRegistryKey = "HKEY_LOCAL_MACHINE\SOFTWARE\Parallels\PVA\agent\"
	End If
End Function

Function GetMSSqlPath 
	Dim value
	If ReadRegistryKey(MSSQL_REG_TOOLS_PATH, value) = 1 Then
		If ReadRegistryKey(MSSQL_REG_TOOLS_PATH_64, value) = 1 Then		 
			FailedQuit "Can't read MSSqlPath"
		End If
	End if
	GetMSSqlPath = """" & TrimSlashes(value) & "\Binn\OSQL.exe" & """"
End function

Function GetSQLRegKey
	If Is64BitSql Then
	    GetSQLRegKey = MSSQL_REG_KEY64
	Else
	    GetSQLRegKey = MSSQL_REG_KEY
	End If
End Function

Function IsSQLInstalled
	Dim value
	IsSQLInstalled = ReadRegistryKey(GetSQLRegKey & PVA_SQL_INSTANCE_NAME & "\MSSQLServer\CurrentVersion\CurrentVersion", value) <> 1
	If IsSQLInstalled Then
		If value < "9.00.3042.00" Then
			IsSQLInstalled = 0
			LogError -1, "MSSQL Server version installed is not supported (" & value & ")"
		End If
	End If
End Function

Function Is64BitSql
	Dim value
	Is64BitSql = ReadRegistryKey(MSSQL_REGPATH_64, value) = 0
End Function

' Reads install dir from registry. Returns empty string if registry key is not found
Function DoSafeGetInstallDir(pva_mn)
	Dim regKeyName
	If pva_mn = 1 Then regKeyName = "mn" Else regKeyName = "agent"
	Dim value
	If ReadRegistryKey("HKLM\Software\Parallels\PVA\" & regKeyName & "\INSTALLDIR", value) <> 0 Then
		If ReadRegistryKey("HKLM\Software\Wow6432Node\Parallels\PVA\" & regKeyName & "\INSTALLDIR", value) <> 0 Then
			value = ""
		End If
	End if
	DoSafeGetInstallDir = TrimSlashes(value)
End Function

Function SafeGetInstallDir(pva_mn)
	If INSTALL_FOLDER = "" Then
		INSTALL_FOLDER = DoSafeGetInstallDir(pva_mn)
	End If
	
	SafeGetInstallDir = INSTALL_FOLDER
End Function

' Returns path to the mn logs folder
Function GetMnLogDir
	Dim shell
	Set shell = WScript.CreateObject("WScript.Shell")
	GetMnLogDir = shell.ExpandEnvironmentStrings("%USERPROFILE%\PVA") & "\Management Server"
End Function

' Returns path to the agent logs folder
Function GetLogDir(pva_mn)
	If LOGS_FOLDER = "" Then
		If pva_mn = 0 Then
			LOGS_FOLDER = GetVzAgentLogDir
		Else
			LOGS_FOLDER = GetMnLogDir
		End If
	End If
	GetLogDir = LOGS_FOLDER
End Function

' Returns path to the agent data folder
Function DoSafeGetDataDir(pva_mn)
	Dim value, vzRoot
	value = SafeGetInstallDir(pva_mn)
	If pva_mn = 0 Then
		If getVirtuozzoRootFolder(vzRoot) = 0 Then
			value = vzRoot & "PVA\Agent"
		End If
	End If
	If value <> "" Then value = value & "\Data"
	DoSafeGetDataDir = value
End Function

Function SafeGetDataDir(pva_mn)
	If DATA_FOLDER = "" Then
		DATA_FOLDER = DoSafeGetDataDir(pva_mn)
	End If
	SafeGetDataDir = DATA_FOLDER
End Function

' Returns path to the agent configuration folder
Function GetEtcDir(pva_mn)
	GetEtcDir = SafeGetDataDir(pva_mn) & "\etc"
End Function

' Returns path to a folder where the agent binaries are
Function GetBinDir(pva_mn)
	GetBinDir = SafeGetInstallDir(pva_mn) & "\bin"
End Function

' Returns the name of a file with the service start arguments
Function GetServiceStartUpFileName
	GetServiceStartUpFileName = "pva.conf"
End Function

Function SafeGetEIDFromConfig(pva_mn)
	Dim dataDir, installDir
	dataDir = SafeGetDataDir(pva_mn)
	installDir = SafeGetInstallDir(pva_mn)
	If dataDir = "" Or installDir = "" Then SafeGetEIDFromConfig = "" : Exit Function
	Dim xmlBinary
	xmlBinary = GetBinDir(pva_mn) & "\vzlxmlman.exe"
	Dim confFile
	confFile = GetEtcDir(pva_mn) & "\vzagent.conf"
	Dim strOutput, strError, ret
	ret = ExecProgram(xmlBinary + " -g data/system/configuration/id """ & confFile & """", "", strOutput, strError)
	If ret <> 0 Then LogError ret, strOutput & strError : strOutput = ""
	SafeGetEIDFromConfig = strOutput
End Function

Function GetAgentServiceName(pva_mn)
	If pva_mn = 1 Then GetAgentServiceName = PVA_SERVICE_NAME_MASTER Else GetAgentServiceName = PVA_SERVICE_NAME_SLAVE
End Function

Function getVirtuozzoRootFolder(ByRef vzinstallPath)
	On Error Resume Next
	Dim sho	
	Set sho = CreateObject("WScript.Shell")
	
	vzinstallPath = sho.RegRead ("HKLM\SOFTWARE\Wow6432Node\SWSoft\Virtuozzo\VZROOT")
	If Err.number <> 0 Then
		Err.Clear
		vzinstallPath = sho.RegRead(GetVzRegistrySubKey("VZROOT"))
		If Err.number <> 0 Then
			getVirtuozzoRootFolder = Err.number
			LogError Err.number,  "Failed to get Virtuozzo root folder - " & Err.Description
			Exit Function
		End If
	End If

	If Right(vzinstallPath, 1) <> "\" Then vzinstallPath = vzinstallPath & "\"
	getVirtuozzoRootFolder = 0
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 GetArchByCpu
	Dim p
	On Error Resume Next
	Set p = GetObject("winmgmts:root/cimv2:win32_Processor='CPU0'")
	If Err.Number <> 0 Then
		GetArchByCpu = Null
	End If 
	If p.Architecture = 6 Then
		GetArchByCpu = "ia64"
	ElseIf p.Architecture = 9 Then
		GetArchByCpu = "x86_64"
	Else
		GetArchByCpu = "i386"
	End If
End Function 

Function GetCpuArch
	If IsEmpty(OS_ARCH) Then
		If Detect64 Then
			OS_ARCH = GetArchByCpu
		Else
			OS_ARCH = "i386"
		End If
	End If
	GetCpuArch = OS_ARCH
End Function

Function GetOsVersion()
	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 
		GetOsVersion = objOs.Version
	Next 

End Function

Function GetArchSuffix
	Dim archSuffix, osVersion
	archSuffix = GetCpuArch
	osVersion = GetOsVersion
	If osVersion < "6.0" Then
		If archSuffix = "i386" Then archSuffix = "windows" Else archSuffix = "windows." & archSuffix
	ElseIf osVersion < "6.2" Then
		If archSuffix = "i386" Then archSuffix = "w2k8" Else archSuffix = "w2k8." & archSuffix
	Else
		If archSuffix = "i386" Then archSuffix = "w2k12" Else archSuffix = "w2k12." & archSuffix
	End If
	GetArchSuffix = archSuffix
End Function

Sub SetupArchVocabulary(path, action)
	Dim fso, pluginsFolder, folder, file, archSuffix
	Set fso = CreateObject("Scripting.FileSystemObject")
	archSuffix = GetArchSuffix

	Set pluginsFolder = fso.GetFolder(path & "\plugins")
	For Each folder In pluginsFolder.SubFolders
		Dim vocName, srcVocName
		vocName = folder.Path & "\" & folder.Name & ".voc"
		srcVocName = vocName & "." & archSuffix
		If fso.FileExists(srcVocName) Then
			If action = "create" Then
				CopyFile srcVocName, vocName
			ElseIf action = "remove" Then
				DeleteFile vocName
			End If
		End If
	Next
End Sub

' Returns path to a Virtuozzo installation folder
Function GetVzInstallDir
	If VZ_INSTALL_FOLDER = "" Then
		Dim v
		' Check 64 bit
		If ReadRegistryKey(GetVzRegistrySubKey("VZINSTALL64"), v) <> 0 Then
			' Check 32 bit
			If ReadRegistryKey(GetVzRegistrySubKey("VZINSTALL"), v) <> 0 Then
				FailedQuit "Failed to read Virtuozzo installation path from registry"
			End If
		End if
		VZ_INSTALL_FOLDER = TrimSlashes(v)
	End If

	GetVzInstallDir = VZ_INSTALL_FOLDER
End Function

Function GetVzBinPath(exe)
	GetVzBinPath = """" & GetVzInstallDir & "\bin\" & exe & """"
End Function

Function RunVzCluster(command)
	Dim c, e, o, p
	p = GetVzBinPath("vzcluster") & " " & command
	c = ExecProgram(p, "", o, e)
	If Not c = 0 Then
		FailedQuitEx c, p & " failed '" & e & "'"
	End If
	RunVzCluster = TrimNewString(o)
End Function

Function DoGetVzClusterState
	If RunVzCluster("isincluster") <> "true" Then
		DoGetVzClusterState = PVA_CS_STANDALONE
	ElseIf RunVzCluster("getnodestate") = "active" Then
		DoGetVzClusterState = PVA_CS_ACTIVE
	Else
		DoGetVzClusterState = PVA_CS_STANDBY
	End If
End Function

Function GetVzClusterState
	If IsEmpty(VZ_CLUSTER_STATE) Then
		VZ_CLUSTER_STATE = DoGetVzClusterState
	End If
	GetVzClusterState = VZ_CLUSTER_STATE
End Function

' Generates a file with the service start arguments
Sub GenerateServiceStartUpFile(pva_mn)
	Dim f
	f = GetBinDir(pva_mn) & "\" & GetServiceStartUpFileName

	' Create config for agent 
	CopyFile f & ".orig", f
	ReplaceInFile f, "[service]", "1"
	ReplaceInFile f, "[install_folder]", SafeGetInstallDir(pva_mn)
	ReplaceInFile f, "[log_folder]", GetLogDir(pva_mn)
	ReplaceInFile f, "[base_folder]", SafeGetDataDir(pva_mn)
	ReplaceInFile f, "[etc_folder]", GetEtcDir(pva_mn)
End Sub

Function GetVzRegistrySubKey(name)
	const VZ_REGISTRY_KEY = "HKLM\Software\SWsoft\Virtuozzo"
	GetVzRegistrySubKey = VZ_REGISTRY_KEY & "\" & name
End Function

Function GetVzLogDir
	Dim v
	If ReadRegistryKey(GetVzRegistrySubKey("LOGDIR"), v) <> 0 Then
		FailedQuit "Failed to read Virtuozzo log path from registry"
	End If
	GetVzLogDir = TrimSlashes(v)
End Function

' Returns path to the Vz agent logs folder and creates it if it doesn't exist
Function GetVzAgentLogDir
	Dim p, e
	p = GetVzLogDir
	For Each e in ARRAY("PVA", "Agent")
		p = p & "\" & e
		CreateFolder(p)
	Next
	GetVzAgentLogDir = p
End Function

Function DoGetAgentBinary
	If PVA_MN_CORE = 1 Then
		DoGetAgentBinary = GetBinDir(PVA_MN_CORE) & "\pvamnd.exe"
	Else
		DoGetAgentBinary = GetBinDir(PVA_MN_CORE) & "\pvaagentd.exe"
	End If
End Function

Function GetAgentBinary
	If AGENT_BINARY = "" Then
		AGENT_BINARY = DoGetAgentBinary
	End If
	GetAgentBinary = AGENT_BINARY
End Function

Sub RegisterAgentService(dependencies)
	If Not IsArray(dependencies) Then
		dependencies = ARRAY()
	End If
	StopService PVA_SERVICE_NAME_SLAVE
	RegisterService PVA_SERVICE_NAME_SLAVE, _
			PVA_DISPLAY_SERVICE_NAME_SLAVE, _
			PVA_SERVICE_DESCRIPTION_SLAVE, _
			GetAgentBinary & " " & GetServiceStartUpFileName, _
			Null, Null, dependencies

	Dim s
	s = GetVzClusterState
	If s <> PVA_CS_STANDALONE Then
		SetServiceManualStart PVA_SERVICE_NAME_SLAVE
	End If
	If  s <> PVA_CS_STANDBY Then
		StartService PVA_SERVICE_NAME_SLAVE
	End If
End Sub

Function FindServiceEx(name, address, username, password)
	On Error Resume Next
	Dim l
	Set l = CreateObject("WbemScripting.SWbemLocator")
	Set FindServiceEx = l.ConnectServer(address, "", username, password).Get("Win32_Service='" & name & "'")
End Function

Function FindService(name)
	Set FindService = FindServiceEx(name, ".", "", "")
End Function

Sub SetServiceManualStart(name)	
	Dim s
	Set s = FindService(name)
	If IsNull(s) Then
		FailedQuitEx Err.number, "Cannot find service '" & name & "': " & Err.Description
	End If
	On Error Resume Next
	s.ChangeStartMode "Manual"
	If Err.number <> 0 Then
		FailedQuitEx Err.number, "Failed to set the service '" & name & "' start mode: " & Err.Description
	End If
End Sub

Function SafeGetDbScriptsDir(pva_mn)
	If IsEmpty(DB_SCRIPTS_FOLDER) Then
		DB_SCRIPTS_FOLDER = SafeGetInstallDir(pva_mn) & "\db"
	End If
	SafeGetDbScriptsDir = DB_SCRIPTS_FOLDER
End Function

Function GetInstalledVersion
	Dim msi, product
	Set msi = CreateObject("WindowsInstaller.Installer")
	For Each product In msi.RelatedProducts("{8975AF50-46D8-47BB-B506-4C06626005F1}")
		GetInstalledVersion = Split(msi.ProductInfo(product, "VersionString"), ".")
		Exit Function
	Next
	GetInstalledVersion = Null
End Function

Sub EnableLogRotation(pva_mn)
	Dim o, e, c
	c = ExecProgram("schtasks /create /f /ru System /sc daily /tn """ & PVA_LOG_ROTATE_TASK_NAME _
			& """ /tr ""'" & GetBinDir(pva_mn) & "\logrotate.cmd' \""" _
			& GetLogDir(pva_mn) & "\""", "", o, e)
	If c <> 0 Then
		LogError c, o & e : o = ""
		FailedQuit "Failed to add the log rotation task '" & PVA_LOG_ROTATE_TASK_NAME & "'"
	End if
End Sub

Sub DisableLogRotation
	Dim o, e, c
	ExecProgram("schtasks /delete /tn """ & PVA_LOG_ROTATE_TASK_NAME & """")
	If c <> 0 Then
		LogError c, o & e : o = ""
	End if
End Sub

Function SafeGetDbScriptsFile(pva_mn)
	SafeGetDbScriptsFile = SafeGetDbScriptsDir(pva_mn) & "\dbupgradefiles.list"
End Function
