%@ Language=VBScript %>
<% Option Explicit %>
<%
' Response.Buffer = True
'-------------------------------------------------------------------------
' site_new.asp: Serves in creating a new site
'
' Copyright (c) Microsoft Corporation. All rights reserved.
'
' Date Description
' 14-Jan-2001 Creation Date
' 25-Jan-2001 Last Modified Date
'-------------------------------------------------------------------------
%>
<%
Err.Clear
'On Error Resume Next
'-------------------------------------------------------------------------
' Global Constants and Variables
'-------------------------------------------------------------------------
Dim G_strAnonName 'to hold Anonymous name
Dim G_strAnonPwd 'to hold Anonymous pwd
Dim G_strDirRoot 'to hold Domainname value
Dim G_strSysName 'to hold system name
Dim G_Browser_Grp 'to hold Browsers group for AD Scenario
Dim G_Admin_Grp 'to hold Admin group for AD Scenario
Dim G_Authors_Grp 'to hold Authors group for AD scenario
Dim G_strSiteName 'to hold site name
Dim G_AnonUserName 'to hold anonymouse username created by IIS
Dim rc 'to hold return count value
Dim page 'to hold page object
Dim idTabGeneral 'to hold Ist tab value
Dim idTabSiteID 'to hold IInd tab value
Dim idTabAppSetting 'to hold Vth tab value
'=========================================================================
' Entry point
'=========================================================================
'
' Set username value
G_AnonUserName = GetIISAnonUsername()
'Create a Tabbed Property Page
rc = SA_CreatePage( L_CREATETASKTITLE_TEXT, "", PT_TABBED, page )
' Add five tabs
rc = SA_AddTabPage( page, L_GENERAL_TEXT, idTabGeneral)
rc = SA_AddTabPage( page, L_SITEIDENTITY_TEXT, idTabSiteID)
rc = SA_AddTabPage( page, L_APPLICATIONSETTINGS_TEXT, idTabAppSetting)
' Show the page
rc = SA_ShowPage( page )
'=========================================================================
' Web Framework Event Handlers
'=========================================================================
'-------------------------------------------------------------------------
' Function: OnInitPage
'
' Synopsis: Called to signal first time processing for this page. Use
' this method to do first time initialization tasks.
'
' Returns: TRUE to indicate initialization was successful. FALSE to
' indicate errors. Returning FALSE will cause the page to be
' abandoned.
'
'-------------------------------------------------------------------------
Public Function OnInitPage(ByRef PageIn, ByRef EventArg)
On Error Resume Next
Call GetDomainRole( G_strDirRoot, G_strSysName )
'init the checkbox
F_strCreatePathChecked = "true"
'
'We won't support create Domain Admin Site anymore
F_strAccountLocation = "1"
OnInitPage = TRUE
End Function
'-------------------------------------------------------------------------
' Function: OnPostBackPage
'
' Synopsis: Called to signal that the page has been posted-back. A post-
' back occurs in tabbed property pages and wizards as the user
' navigates through pages. It is differentiated from a Submit
' or Close operationin that the user is still working with the
' page.
'
' The PostBack event should be used to save the state of page.
'
' Returns: TRUE to indicate initialization was successful. FALSE to
' indicate errors. Returning FALSE will cause the page to be
' abandoned.
'-------------------------------------------------------------------------
Public Function OnPostBackPage(ByRef PageIn, ByRef EventArg)
Err.clear
on Error Resume Next
'get variables from form
call SetGenFormVariables()
call SetSiteIdentitiesFormVariables()
call SetApplnSettingsFormVariables()
Call SA_TRACEOUT("OnPostBackPage","OnPostBackPage called")
OnPostBackPage = TRUE
End Function
'--------------------------------------------------------------------------
' Function: OnServeTabbedPropertyPage
'
' Synopsis: Called when the page needs to be served. Use this method to
' serve content.
'
' Returns: TRUE to indicate not problems occured. FALSE to indicate errors.
' Returning FALSE will cause the page to be abandoned.
'
'--------------------------------------------------------------------------
Public Function OnServeTabbedPropertyPage(ByRef PageIn, _
ByVal iTab, _
ByVal bIsVisible, _
ByRef EventArg)
' Emit Web Framework required functions
If ( iTab = idTabGeneral) Then
Call ServeCommonJavaScript()
End If
' Emit content for the requested tab
Select Case iTab
Case idTabGeneral
Call ServeTabGeneral(PageIn, bIsVisible)
Case idTabSiteID
Call ServeTabSiteID(PageIn, bIsVisible)
Case idTabAppSetting
Call ServeTabAppSetting(PageIn, bIsVisible)
Case Else
SA_TraceOut "TEMPLAGE_TABBED", _
"OnServeTabbedPropertyPage unrecognized tab id: " + _
CStr(iTab)
End Select
OnServeTabbedPropertyPage = TRUE
End Function
'-------------------------------------------------------------------------
' Function: OnSubmitPage
'
' Synopsis: Called when the page has been submitted for processing. Use
' this method to process the submit request.
'
' Returns: TRUE if the submit was successful, FALSE to indicate error(s).
' Returning FALSE will cause the page to be served again using
' a call to OnServePropertyPage.
'
'-------------------------------------------------------------------------
Public Function OnSubmitPage(ByRef PageIn, ByRef EventArg)
OnSubmitPage = CreateSite()
End Function
'-------------------------------------------------------------------------
' Function: OnClosePage
'
' Synopsis: Called when the page is about to be closed. Use this method
' to perform clean-up processing.
'
' Returns: TRUE to allow close, FALSE to prevent close. Returning FALSE
' will result in a call to OnServePropertyPage.
'
'-------------------------------------------------------------------------
Public Function OnClosePage(ByRef PageIn, ByRef EventArg)
OnClosePage = TRUE
End Function
'=========================================================================
' Private Functions
'=========================================================================
'-------------------------------------------------------------------------
'Function name :ServeTabGeneral
'Description :Serves General tab
'Input Variables :PageIn, bIsVisible
'Output Variables :None
'Returns :Success(Return value)
'Global Variables :None
'-------------------------------------------------------------------------
Function ServeTabGeneral(ByRef PageIn, ByVal bIsVisible)
If ( bIsVisible ) Then
call GeneralViewTab()
Else
'update hidden variables
call GeneralHiddenTab()
End If
ServeTabGeneral = gc_ERR_SUCCESS
End Function
'-------------------------------------------------------------------------
'Function name :ServeTabSiteID
'Description :Serves the Site identities tab
'Input Variables :PageIn, bIsVisible
'Output Variables :None
'Returns :Success(Return value)
'Global Variables :None
'-------------------------------------------------------------------------
Function ServeTabSiteID(ByRef PageIn, ByVal bIsVisible)
If ( bIsVisible ) Then
call SiteIdentitiesViewTab()
Else
'update hidden variables
call SiteIdentitiesHiddenTab()
End If
ServeTabSiteID = gc_ERR_SUCCESS
End Function
'-------------------------------------------------------------------------
'Function name :ServeTabAppSetting
'Description :Serve the Application Settings tab
'Input Variables :PageIn, bIsVisible
'Output Variables :None
'Returns :Success(Return value)
'Global Variables :None
'-------------------------------------------------------------------------
Function ServeTabAppSetting(ByRef PageIn, ByVal bIsVisible)
If ( bIsVisible ) Then
call ApplicationSettingsViewTab()
Else
'update hidden variables
call ApplicationSettingsHiddenTab()
end if
ServeTabAppSetting = gc_ERR_SUCCESS
End Function
'-------------------------------------------------------------------------
' Function: ServeCommonJavaScript
'
' Synopsis: Common javascript functions that are required by the Web
' Framework.
'
'------------------------------------------------------------------------
Function ServeCommonJavaScript()
Err.clear
on Error Resume Next
%>
<%
End Function
'----------------------------------------------------------------------------
'Function name :CreateSite
'Description :Serves in Creating a New Web Site
'Input Variables :None
'Output Variables :None
'Returns :Boolean (True if new site is created else returns False)
'Global Variables :None
'Functions Used :blnValidateInputs
' HandleWrkgrpAndNTDC
' blnCreateWebSite
' blnSetDiskQuotas
' blnSetDACLEntry
'----------------------------------------------------------------------------
Function CreateSite()
on error resume next
Err.Clear
Call SA_TraceOut(SA_GetScriptFileName(), "Entering CreateSite()")
Dim objRoot 'holds root object
Dim strUserName 'hold user name
Dim WebName 'hold web name
Dim strBool
CreateSite = FALSE
Call GetDomainRole( G_strDirRoot, G_strSysName )
Call SA_TraceOut(SA_GetScriptFileName(), "System name: " + CStr(G_strSysName))
Call SA_TraceOut(SA_GetScriptFileName(), "Directory root: " + CStr(G_strDirRoot))
' Bind to the root object
If F_strAccountLocation = "1" Then
Set objRoot = GetObject("WinNT://" & G_strSysName)
Else
Set objRoot = GetObject("WinNT://" & G_strDirRoot)
End If
If Err.number <> 0 Then
Call SA_TraceOut(SA_GetScriptFileName(), "Error creating Root object, error: " + CStr(Hex(Err.Number)) + " " + Err.Description)
Call SA_SetErrMsg(SA_GetLocString("Sitearea.dll", "C04201D4", Array("WinNT://" & G_strDirRoot)))
Exit Function
End if
'
' If an existing account was specified then the account name needs to be
' in the form ComputerName\AccountName. If the user did not enter the name
' in this form, then correct the name to match this format.
If ( F_strAccountLocation = "2" ) Then
If ( InStr(F_strAdminName, "\") = 0 ) Then
F_strAdminName = G_strSysName & "\" & F_strAdminName
End If
End If
'user and groups names to be created
G_strAnonName = F_strSiteID & "_Anon"
G_Browser_Grp = F_strSiteID & "_Browsers"
G_Admin_Grp = F_strSiteID & "_Admins"
G_Authors_Grp = F_strSiteID & "_Authors"
'1) verify input datas
if ( NOT blnValidateInputs()) then
Call SA_TraceOut(SA_GetScriptFileName(), "Error in input parameters")
Exit Function
End If
'2) Create site users and generate the anonymous user's pwd
If ( NOT CreateSiteUsers(objRoot)) Then
Call SA_TraceOut(SA_GetScriptFileName(), "CreateSiteUsers error: " + CStr(Hex(Err.Number)) + " " + Err.Description)
Exit Function
End If
'3) Create Web site. Use the Admin and Anon users created above for this
If( NOT blnCreateWebSite(F_strSiteID, _
F_strIPAddr, _
F_strPort, _
F_strHeader, _
F_strDir, _
F_strchkAllow, _
F_selectActiveFormat, _
F_strAdminName, _
F_strDefaultPageText)) then
Call SA_TraceOut(SA_GetScriptFileName(), "CreateWebSite error: " + CStr(Hex(Err.Number)) + " " + Err.Description)
' If we did not use an existing user account then we need to
' delete the accounts we created (see CreateSiteUsers function).
If (F_strAccountLocation <> "2") Then
Call blnDeleteUser(objRoot, F_strAdminName)
Call blnDeleteUser(objRoot, G_strAnonName)
end if
SA_ServeFailurePage L_CREATEFAIL_ERRORMESSAGE
exit function
end if 'create site
'4)Config directory DACL
If(NOT ConfigDirDACL(F_strDir, F_strAdminName)) Then
Call SA_TraceOut(SA_GetScriptFileName(), "ConfigDirDACL error: "+ CStr(Hex(Err.Number)) + " " + Err.Description)
Exit Function
End If
'6) config virtual FTP site
If F_strUploadMethod = UPLOADMETHOD_FTP Then
Dim objService
Set objService = getWMIConnection(CONST_WMI_IIS_NAMESPACE)
If (NOT CreateVirFTPSite(objService, F_strAdminName, F_strDir, True, True, True)) Then
Call SA_TraceOut(SA_GetScriptFileName(), "CreateVirFTPSite error: "+ CStr(Hex(Err.Number)) + " " + Err.Description)
SetErrMsg L_ERR_CREATE_VIR_FTP_SITE
If ( Len(GetErrMsg()) <= 0 ) Then
Call SA_SetErrMsg(GetLocString("sitearea.dll", "404201DC", ""))
End If
Exit Function
End If
Set objService = Nothing
End If
'7) Setting return URL
WebName = GetWebSiteNo(F_strSiteID)
Call SA_TraceOut(SA_GetScriptFileName(), "New WebSite ID: " + CStr(WebName))
Call SA_MungeURL(mstrReturnURL, "PKey",WebName)
Call SA_TraceOut(SA_GetScriptFileName(), "ReturnURL: " + mstrReturnURL)
'5) Config Frontpage
If( NOT ConfigFrontPage(F_strAdminName)) Then
Call SA_TraceOut(SA_GetScriptFileName(), "ConfigFrontPage error: "+ CStr(Hex(Err.Number)) + " " + Err.Description)
If ( Len(GetErrMsg()) <= 0 ) Then
Call SA_SetErrMsg(L_ERR_FRONTPAGE_CONFIGURATION)
End If
Exit Function
End If
CreateSite = TRUE
Call SA_TraceOut(SA_GetScriptFileName(), "CreateSite() return code: " + CStr(CreateSite))
'release objects
'Set objRoot = nothing
end function
'----------------------------------------------------------------------------
'Function name :CreateSiteUsers
'Description :Serves in create administrator users
'Input Variables :None
'Output Variables :None
'Returns :Boolean (True if new site is created else returns False)
'Global Variables :None
'Functions Used :
'----------------------------------------------------------------------------
Function CreateSiteUsers(ByRef objRoot)
On Error Resume Next
Err.Clear
CreateSiteUsers = False
'creates necessary ou's, users and groups, cleansup if
'something fails
If F_strAccountLocation = "1" then
'creates necessary users , cleansup if something fails
if NOT HandleWrkgrpAndNTDC(objRoot) then
exit function
end if
Elseif F_strAccountLocation = "2" Then
'valid the exist user and prompt the user when err
Dim objComputer
Dim oUser
Dim arrId
Dim strDomain
Dim strUser
arrId = split(F_strAdminName,"\")
If ubound(arrId) <> 1 Then
SetErrMsg L_ERR_ADMINISTRATOR_NAME
Exit Function
End If
strDomain = arrId(0)
strUser = arrId(1)
set objComputer = GetObject("WinNT://" & strDomain)
If Err.number <> 0 Then
SetErrMsg SA_GetLocString("Sitearea.dll", _
"C04201D4", _
Array("WinNT://" & strDomain))
Exit Function
End if
Set oUser = objComputer.GetObject("user" , trim(strUser))
If Err.number <> 0 Then
SetErrMsg L_ERR_ACCOUNT_NOT_FOUND
Exit Function
End if
End If
CreateSiteUsers = True
End Function
'----------------------------------------------------------------------------
'Function name :ConfigDirDACL
'Description :Serves in set permission of directory
'Input Variables :None
'Output Variables :None
'Returns :Boolean (True if new site is created else returns False)
'Global Variables :None
'Functions Used :
'----------------------------------------------------------------------------
Function ConfigDirDACL(strDir,strAdminName)
On Error Resume Next
Err.Clear
ConfigDirDACL = False
' Set DACL entries for Anon and Admin users for Home Directory
if (NOT SetDaclForRootDir(strDir,strAdminName)) then
Call SA_SetErrMsg(L_DACL_ERRORMESSAGE)
Call SA_TraceOut ("site_new", "Failed to set the DACL for root dir ")
Exit Function
end if
ConfigDirDACL = True
End Function
'----------------------------------------------------------------------------
'Function name :ConfigFrontPage
'Description :Serves in config front page
'Input Variables :None
'Output Variables :None
'Returns :Boolean (True if new site is created else returns False)
'Global Variables :None
'Functions Used :
'----------------------------------------------------------------------------
Function ConfigFrontPage(strAdminName)
On Error Resume Next
Err.Clear
Dim objService
Dim strUserName
Set objService = getWMIConnection(CONST_WMI_IIS_NAMESPACE)
ConfigFrontPage = True
'
' Configure FrontPage Server Extensions if they are installed and were
' selected by the user.
'
If ( TRUE = isFrontPageInstalled(objService) And _
UPLOADMETHOD_FPSE = F_strUploadMethod) Then
ConfigFrontPage = False
'
' User name depends on account type
select case F_strAccountLocation
case "1"
strUserName = G_strSysName & "\" & strAdminName
case "2"
strUserName = strAdminName
case else
Call SA_TraceOut(SA_GetScriptFileName(), "Function ConfigFrontPage encountered unexpected AccountLocation code: " + CStr(F_strAccountLocation))
Exit Function
end select
ConfigFrontPage = UpdateFrontPage(True, G_strSiteName, strUserName)
End If
End Function
'-------------------------------------------------------------------------
'Function name :HandleWrkgrpAndNTDC
'Description :Creates req users in case of Workgrp and NTDC scenario
'Input Variables :objRoot
'Output Variables :None
'Returns :boolean
'Global Variables :None
'-------------------------------------------------------------------------
Function HandleWrkgrpAndNTDC( objRoot )
Err.Clear
On Error Resume Next
Dim objSAHelper
Dim strPassword
Dim bCreatingAnon
HandleWrkgrpAndNTDC = FALSE
'If we are creating Anonymous account we need to set these properties to
' TRUE
' 1) Password Never Expires
' 2) User cannot change password
bCreatingAnon = False
' Create Admin user first because it is used for setting site operator
if ( Not blnCreateUser(objRoot, F_strAdminName, F_strAdminPswd, bCreatingAnon) ) then
Exit Function
End If
Set objSAHelper = server.CreateObject("ServerAppliance.SAHelper")
if Err.number <> 0 then
Call SA_TraceOut ("site_new", "createobject for sahelper failed")
exit function
else
strPassword = objSAHelper.GenerateRandomPassword(14)
if Err.number <> 0 then
Call SA_TraceOut ("site_new", "generate random password failed")
Set objSAHelper = Nothing
exit function
end if
end if
Set objSAHelper = Nothing
'Create Anonymous user for setting anonymous user settings in the web
'site
SA_traceOut "G_strAnonName:", G_strAnonName
bCreatingAnon = True
'
'Set the pwd of the anonymous user, it needs to be used when we set the webvirdir object.
'That's because of the IIS security change, which won't install sub-authenticator from
'installation.
G_strAnonPwd = strPassword
SA_TraceOut "G_strAnonPwd:", G_strAnonPwd
if ( Not blnCreateUser(objRoot, G_strAnonName, strPassword, bCreatingAnon) ) then
Call blnDeleteUser(objRoot, F_strAdminName)
Exit Function
End If
HandleWrkgrpAndNTDC = TRUE
End Function
'-------------------------------------------------------------------------
'Function name :blnValidateInputs
'Description :Validate Site identifier, directory path and admin
' user
'Input Variables :
'Output Variables :None
'Returns :boolean
'Global Variables :None
'-------------------------------------------------------------------------
Function blnValidateInputs()
Err.clear
On Error Resume Next
blnValidateInputs = FALSE
Dim arrFullName
'1) Check whether the site Identifier exists
If F_strAccountLocation = "1" Then
if isValidSiteIdentifier(F_strSiteID, F_strAdminName, G_strSysName, True) = false then
mintTabSelected = 0
SetErrMsg SA_GetLocString("Sitearea.dll", _
"C04200C1", _
Array(F_strSiteID))
exit Function
end if
Elseif F_strAccountLocation = "2" Then
if isValidSiteIdentifier(F_strSiteID, "", "", False) = false then
mintTabSelected = 0
SetErrMsg SA_GetLocString("Sitearea.dll", _
"C04200C1", _
Array(F_strSiteID))
exit Function
end if
End If
'2) validates the dir and create the dir if necessary
if (NOT ValidateSitePath(F_strCreatePathChecked, F_strDir)) then
exit function
end if
Call SA_TraceOut( "site_new", "validateinputs successful" )
blnValidateInputs = true
end function
'-------------------------------------------------------------------------
'Function name :blnCreateUser
'Description :Function to create user
'Input Variables :objRoot, strUserName, strPassword
'Output Variables :None
'Returns :Boolean
'Global Variables :None
'
'-------------------------------------------------------------------------
Function blnCreateUser(objRoot, strUserName, strPassword, bCreatingAnon)
Dim objUser 'holds user object
Dim flagPasswd
Err.Clear
On Error Resume Next
blnCreateUser = false
' create Admin user in SAM
Set objUser = objRoot.Create("user" , trim(strUserName))
objUser.setPassword(trim(strPassword))
objUser.FullName = strUserName
objUser.Description = strUserName
'If we are creating Anonymous account we need to set these properties to
' TRUE
' 1) Password Never Expires
' 2) User cannot change password
If bCreatingAnon Then
flagPasswd = &H10040
objUser.Put "userFlags", flagPasswd
End If
objUser.SetInfo()
If Err.number <> 0 Then
mintTabSelected = 0
If Err.number = &H800708C5 Then
SetErrMsg L_ERR_PASSWORD_POLICY
Else
SetErrMsg L_UNABLETOSET_PASSWORD_ERRORMESSAGE
End If
exit Function
end if
'release objects
set objUser = nothing
SA_traceout "blncreateuser success: strUserName", strUserName
blnCreateUser = true
End function
'-------------------------------------------------------------------------
'Function name :blnCreateWebSite
'Description :Creating new web site
'Input Variables :None
'Output Variables :None
'Returns :Boolean (True if new site is created else returns
' False)
'Global Variables :None
'-------------------------------------------------------------------------
Function blnCreateWebSite(strSiteID, _
strIPAddr, _
strPort, _
strHeader, _
strDir, _
strchkAllow, _
selectActiveFormat, _
strAdminName, _
strDefaultPageText)
On Error Resume Next
Err.Clear
Dim objService 'holds WMI connection object
Dim objMasterWeb 'holds MasterWeb Connection
Dim instWeb 'holds intance web
Dim retVal 'holds return value
Dim arrBindings 'holds arraybinidngs object
Dim nNewSiteNo 'holds new site number
Dim strSiteNum 'holds new site name
Dim objSetting 'holds WMI Connection object
Dim bIIS 'Allow IIS control password
Dim siteName
Dim strAnonPropUserName,strAnonPropPwd
'strAnonPropPwd holds the pwd of the anon user created
strAnonPropPwd = ""
Call SA_TraceOut ("site_new", "In handle blnCreateWebSite function")
blnCreateWebSite = FALSE
nNewSiteNo = GetNewSiteNo()
'
' Delete any existing FrontPage Extension configuration for this new web site. We need
' to do this because FPSE does not clean-up after itself when a site is deleted. If someone
' manually deletes a site using the IIS snap-in, FPSE configuration information is left in the REG
' and we need to clear that out so the previous setting do not interfere with this new site.
siteName = "W3SVC/"+CStr(nNewSiteNo)
Call SA_TraceOut(SA_GetScriptFileName(), "Calling UpdateFrontPage(false, " & siteName & ", " & strAdminName & ") to delete FPSE")
Call UpdateFrontPage("false", siteName, strAdminName)
'Get ServerBindings Value
arrBindings = array(GetBindings(strIPAddr, strPort, strHeader))
Set objService = getWMIConnection(CONST_WMI_IIS_NAMESPACE)
Set instWeb = objService.Get(GetIISWMIProviderClassName("IIs_WebService") & ".Name='W3SVC'")
If Err.Number <> 0 Then
SetErrMsg L_INFORMATION_ERRORMESSAGE
Exit Function
End If
If IsIIS60Installed() Then
' In IIS 6.0 WMI, Create a new web site needs to call CreateNewSite
' and it takes ServerBinding object as input argument instead of using
' a array of strings for bindings
Dim arrObjBindings(0)
set arrObjBindings(0) = objService.Get("ServerBinding").SpawnInstance_
arrObjBindings(0).Port = strPort
arrObjBindings(0).IP = strIPAddr
arrObjBindings(0).Hostname = strHeader
' Create the website thru 6.0 WMI provider
instWeb.CreateNewSite strSiteID, arrObjBindings, strDir, nNewSiteNo
Else
retVal = instWeb.CreateNewServer(nNewSiteNo, strSiteID, arrBindings, strDir)
End If
If Err.Number <> 0 Then
SetErrMsg L_CREATEFAIL_ERRORMESSAGE
Exit Function
End If
instWeb.Put_(WBEMFLAG) ' register the object created
If Err.Number <> 0 Then
SetErrMsg L_UPDATEFAIL_ERRORMESSAGE
Exit Function
End If
strSiteNum = instWeb.Name & "/" & nNewSiteNo
' Get the Internal Site Identifier of the created Web site
G_strSiteName = strSiteNum
'1) Set ServerID property for newly created site
if MakeManagedSite(objService, strSiteNum,strSiteID) = false then
SetErrMsg L_CRMANAGEDSITE_REGKEY_ERRORMESSAGE
'delete site and exit
retVal = DeleteWebSite( objService, strSiteNum )
Exit Function
end if
If F_strAccountLocation = "1" Then
strAnonPropUserName=G_strAnonName
'Set the pwd to the generated pwd for anon user
strAnonPropPwd = G_strAnonPwd
Else ' (F_strAccountLocation = "2")
strAnonPropUserName = G_AnonUserName
End If
bIIS = True
if NOT SetAnonProp(objService, strSiteNum, strchkAllow, _
strAnonPropUserName, strAnonPropPwd, bIIS) then
retVal = DeleteWebSite( objService, strSiteNum )
Exit Function
end if
'2) Create Site Operator
if NOT blnCreateIISOperator(objService, strSiteNum,strAdminName) then
retVal = DeleteWebSite( objService, strSiteNum )
Call SA_TRACEOUT("blnCreateWebSite","Create Site Operator failed")
Exit Function
end if
'3) Set Access Read properties for Site
if selectActiveFormat = "" then
Set objSetting =objService.Get(GetIISWMIProviderClassName("IIs_WebServiceSetting") & ".Name='W3SVC'")
if objSetting.Name = "W3SVC" then
if objSetting.AccessExecute = TRUE and _
objSetting.AccessScript = TRUE then
selectActiveFormat = 2
elseif objSetting.AccessExecute = false and _
objSetting.AccessScript = TRUE then
selectActiveFormat = 1
elseif objSetting.AccessExecute = false and _
objSetting.AccessScript = false then
selectActiveFormat =0
elseif isnull(objSetting.AccessExecute) and _
isnull(objSetting.AccessScript) then
selectActiveFormat = 0
end if
end if
'Release the object
set objSetting = nothing
end if
'4) Set execute perms for Site
if NOT SetExecPerms(selectActiveFormat, objService, _
strSiteNum) then
retVal = DeleteWebSite( objService, strSiteNum )
Exit Function
end if
'5) Set Access Read properties for Site
if NOT SetApplRead( objService, strSiteNum) then
retVal = DeleteWebSite( objService, strSiteNum )
Exit Function
end if
'6) Set default web page
if NOT SetWebDefaultPage( objService, strDefaultPageText, strSiteNum) then
retVal = DeleteWebSite( objService, strSiteNum )
Exit Function
end if
'7) Start the Website
retVal = StartWebSite(objService, strSiteNum )
'next
Call SA_TraceOut ( "site_new.asp", "blnCreateWebSite Suceesfull" )
'release objects
set objService = nothing
set objMasterWeb = nothing
blnCreateWebSite = true
End function
'-------------------------------------------------------------------------
'Function name :SetDaclForRootDir
'Description :Sets the DACL for root dir
'Input Variables :None
'Output Variables :None
'Returns :Boolean
'Global Variables :F_strDir, G_strAnonName, F_strAdminName
'-------------------------------------------------------------------------
Function SetDaclForRootDir(byref strDir, strAdminName)
On Error Resume Next
Err.Clear
SetDaclForRootDir = FALSE
Dim objService 'to hold WMI connection object
Dim strTemp 'to hold temp value
Dim objSecSetting 'to hold security setting value
Dim objSecDescriptor 'to hold security descriptor value
Dim strPath 'to hold Path
Dim objDACL 'to hold DACL value
Dim objSiteAdminAce 'to hold site ACE
Dim objAdminAce 'to hold Admine ace
Dim objAnonAce 'to hold Anon ace
Dim objAuthAce 'to hold Auth ace
Dim objDomainAce 'to hold domain admin ace
Dim retval 'holds return value
Set objService = getWMIConnection(CONST_WMI_WIN32_NAMESPACE)
objService.security_.impersonationlevel = 3
'get the sec seting for file
strPath = "Win32_LogicalFileSecuritySetting.Path='" & strDir & "'"
set objSecSetting = objService.Get(strPath)
if Err.number <> 0 then
Call SA_TraceOut ("site_new", "Failed to get Sec object for dir ")
exit function
end if
'get the ace's for all req users
If F_strAccountLocation = "1" Then
'
' add access user to root dir
'
if NOT GetUserAce(objService, strAdminName , G_strSysName, _
CONST_FULLCONROL, objSiteAdminAce ) then
Call SA_TraceOut ("site_new", _
"Failed to get ACE object for Site Admin user ")
exit function
end if
if NOT GetUserAce(objService, G_strAnonName, G_strSysName, _
CONST_READEXEC, objAnonAce ) then
Call SA_TraceOut ( "site_new", _
"Failed to get ACE object for Anon user ")
exit function
end if
'
' add access group to root dir
'
if NOT GetGroupAce(objService, SA_GetAccount_Administrators() , GetComputerName(), _
CONST_FULLCONROL, objAdminAce ) then
Call SA_TraceOut ("site_new", _
"Failed to get ACE object for Admin user")
exit function
end if
Elseif F_strAccountLocation = "2" Then
Dim arrId
Dim strDomain
Dim strUser
arrId = split(F_strAdminName,"\")
If ubound(arrId) <> 1 Then
SetErrMsg L_ERR_ADMINISTRATOR_NAME
Exit Function
End If
strDomain = arrId(0)
strUser = arrId(1)
'add access users in the location
if NOT GetUserAce(objService, strUser , strDomain, _
CONST_FULLCONROL, objSiteAdminAce ) then
Call SA_TraceOut ("site_new", _
"Failed to get ACE object for Site Admin user ")
exit function
end if
'IUSR_hostname (anonymous username created by IIS)
if NOT GetUserAce(objService, G_AnonUserName , G_strSysName, _
CONST_READEXEC, objAnonAce ) then
Call SA_TraceOut ("site_new", _
"Failed to get ACE object for Admin user")
exit function
end if
'add access group in the location
If ucase(strDomain) = ucase(G_strSysName) Then
if NOT GetGroupAce(objService, SA_GetAccount_Administrators() , GetComputerName(), _
CONST_FULLCONROL, objAdminAce ) then
Call SA_TraceOut ("site_new", _
"Failed to get ACE object for Admin user")
exit function
end if
Else
if NOT GetGroupAce(objService, SA_GetAccount_Administrators() , GetComputerName(), _
CONST_FULLCONROL, objAdminAce ) then
Call SA_TraceOut ("site_new", _
"Failed to get ACE object for Admin user")
exit function
end if
if NOT GetGroupAce(objService, "Domain Admins" , strDomain,_
CONST_FULLCONROL, objDomainAce ) then
Call SA_TraceOut ("site_new", _
"Failed to get ACE object for Admin user")
exit function
end if
End if
End If
Set objSecDescriptor = objService.Get("Win32_SecurityDescriptor").SpawnInstance_()
if Err.Number <> 0 then
Call SA_TraceOut ("site_new", _
"Failed to get create the Win32_SecurityDescriptor object ")
exit function
end if
objSecDescriptor.Properties_.Item("DACL") = Array()
Set objDACL = objSecDescriptor.Properties_.Item("DACL")
If F_strAccountLocation = "1" Then
objDACL.Value(0) = objSiteAdminAce
objDACL.Value(1) = objAdminAce
objDACL.Value(2) = objAnonAce
ElseIf F_strAccountLocation = "2" Then
objDACL.Value(0) = objSiteAdminAce
objDACL.Value(1) = objAdminAce
objDACL.Value(2) = objAnonAce
If Not IsEmpty(objDomainAce) Then
objDACL.Value(3) = objDomainAce
End If
End If
objSecDescriptor.Properties_.Item("ControlFlags") = 32772
Set objSecDescriptor.Properties_.Item("Owner") = objSiteAdminAce.Trustee
Err.Clear
retval = objSecSetting.SetSecurityDescriptor( objSecDescriptor )
if Err.number <> 0 then
Call SA_TraceOut ( "site_new", _
"Failed to set the Security Descriptor for Root dir ")
exit function
end if
Call SA_TraceOut ("site_new", "In SetDaclForRootDir success" )
SetDaclForRootDir = TRUE
'Release the objects
set objService = nothing
set objSecSetting = nothing
set objSecDescriptor = nothing
End function
'-------------------------------------------------------------------------
'Function name :blnDeleteUser
'Description :Deletes users if site not created
'Input Variables :None
'Output Variables :None
'Returns :Boolean
'Global Variables :None
'-------------------------------------------------------------------------
Sub blnDeleteUser(objRoot, strUserName)
On Error Resume Next
Err.Clear
Dim nretval 'to hold return value
'deletes the Anonymous User from the System
nretval = objRoot.Delete("user" , strUserName)
If Err.Number <> 0 Then
Call SA_TraceOut ("site_new", L_CANNOTDELETE_CREATEDUSERS_ERRORMESSAGE )
End If
End Sub
'-------------------------------------------------------------------------
'Function name :DeleteWebSite
'Description :Deletes the web site
'Input Variables :objService, strSiteNum
'Output Variables :None
'Returns :Boolean
'Global Variables :None
'-------------------------------------------------------------------------
Function DeleteWebSite( objService, strSiteNum )
On Error Resume Next
Err.Clear
Dim strObjPath 'holds site collection
Dim objWebSite 'holds instance of the site
DeleteWebSite = FALSE
strObjPath = GetIISWMIProviderClassName("IIs_WebServer") & ".Name=" & chr(34) & strSiteNum & chr(34)
Set objWebSite = objService.Get(strObjPath)
if Err.Number <> 0 then
Call SA_TraceOut("site_new","Unable to get the web server object ")
Exit Function
End If
'delete the object
objWebSite.Delete_
if Err.Number <> 0 then
SA_TraceOut "site_new", "Unable to delete the web site "
Exit Function
End If
DeleteWebSite = TRUE
'Release the object
set objWebSite = nothing
End Function
'-------------------------------------------------------------------------
'Function name :blnCreateIISOperator
'Description :creates operators for the site
'Input Variables :objService, strSiteNum
'Output Variables :None
'Returns :Boolean
'Global Variables :None
'-------------------------------------------------------------------------
Function blnCreateIISOperator(objService, strSiteNum,strAdminName)
On Error Resume Next
Err.Clear
Dim objACE 'holds ACE
Dim strQuery 'holds Query string
Dim objAdminACLInstanceSet 'holds Admin ACL instanceset
Dim objAdminACLInstance 'holds Admin ACL instance
blnCreateIISOperator = FALSE
strQuery= GetIISWMIProviderClassName("IIs_AdminACL") & ".Name='" & strSiteNum &"'"
set objAdminACLInstanceSet = objService.Get(strQuery)
if err.number<>0 then
'note action req
SetErrMsg L_INFORMATION_ERRORMESSAGE
exit function
end if
set objACE = objService.Get(GetIISWMIProviderClassName("IIs_ACE")).SpawnInstance_()
if err.number <>0 then
SetErrMsg L_INFORMATION_ERRORMESSAGE
exit function
end if
objACE.Name = objAdminACLInstanceSet.Name
objACE.AccessMask = 11
objACE.AceFlags = 0
objACE.AceType = 0
objACE.Trustee = strAdminName
objACE.Put_(WBEMFLAG)
blnCreateIISOperator = TRUE
'release objects
set objACE = nothing
set objAdminACLInstanceSet = nothing
End function
'-------------------------------------------------------------------------
'Function name :ValidateSitePath
'Description :Validate Directory path, creates if necessary
'Input Variables :None
'Output Variables :None
'Returns :Boolean
'Global Variables :None
'-------------------------------------------------------------------------
Function ValidateSitePath(strCreatePathChecked,strFormDir)
Err.Clear
on error resume next
Dim objFso 'holds FileSystem object
Dim strDir 'holds Director path
Dim strIndx 'holds index value
Dim strDriveName 'holds drive name
Dim strQuery 'holds Query string
Dim objService 'holds WMI Connection
Dim objDirList 'holds Virtualdirectory collection list
Dim objDir 'holds instance of Virtualdirectory list
Dim strParentDir 'holds parent directory path
Dim nRetVal 'holds return value
Dim strDirPath 'holds directory path
Dim strWinDirPath 'holds windows directory path
ValidateSitePath = false
Set objFso = server.CreateObject("Scripting.FileSystemObject")
if Err.number <> 0 then
SetErrMsg L_FILEINFORMATION_ERRORMESSAGE
exit function
end if
Call SA_TRACEOUT("ValidateSitePath", CStr(strCreatePathChecked))
if strCreatePathChecked <> "true" then
'if folder does not exist, give error as folder does not exist
if objFso.FolderExists(strFormDir)=false then
SetErrMsg L_DIR_DOESNOT_EXIST_ERRMSG
exit function
end if
end if
Set objService = getWMIConnection(CONST_WMI_IIS_NAMESPACE)
strQuery = "select path from " & GetIISWMIProviderClassName("IIs_WebVirtualDirSetting")
set objDirList=objService.Execquery(strQuery)
if Err.number <> 0 then
SetErrMsg L_INFORMATION_ERRORMESSAGE
exit function
end if
'truncate last '\' char
if Right( strFormDir, 1 ) = "\" then
strFormDir = Left(strFormDir, len(strFormDir) - 1)
end if
strParentDir = objFso.GetParentFolderName(strFormDir)
for each objDir in objDirList
if strComp(objDir.path, strFormDir, 0) = 0 OR _
strComp(objDir.path, strParentDir, 0) = 0 then
mintTabSelected = 0
SetErrMsg L_DIR_FOR_WEB_SITES_TEXT
exit function
end if
next
'check whether the Dir entered is Windows dir
if len(objFso.GetSpecialFolder(0)) = len(strFormDir) then
strWinDirPath = objFso.GetSpecialFolder(0)
else
strWinDirPath = objFso.GetSpecialFolder(0) & "\"
end if
strDirPath = mid(strFormDir,1,len(strWinDirPath))
if StrComp(trim(strDirPath),strWinDirPath,1) = 0 then
SetErrMsg L_INVALID_DIR_PATH_ERRMSG
mintTabSelected = 0
exit Function
end if
nRetVal = CreateSitePath( objFso, strFormDir )
if nRetVal <> CONST_SUCCESS then
if nRetVal = CONST_INVALID_DRIVE then
SetErrMsg L_INVALID_DRIVE_ERRMSG
elseif nRetVal = CONST_NOTNTFS_DRIVE then
SetErrMsg L_NOT_NTFS_DRIVE_ERRMSG
else
SetErrMsg L_FAILED_CREATE_DIR_ERRMSG
end if
mintTabSelected = 0
exit Function
end if
'release objects
set objFso = nothing
set objDirList = nothing
set objService = nothing
ValidateSitePath = true
end function
%>