siliconpizza.com

some REALLY rough and not very elegent code but this is my website create code for IIS6

Points to note:

• I centrally manage the W3SVC instance number, so they are unique across all of the platforms in the enterprise, hence the instance number is specified , not generated in the function
• I use AD based IWAM accounts to connect to CIFS (UNC) based content, so these have to be specified
• hosts string is a comma separated list of hostheaders,

Function createsite(ByVal StrMachine As String, ByVal StrSitenumber As String, ByVal StrSiteDesc As String, ByRef Hosts As String, ByVal IwamUser As String, ByVal IWamPass As String, ByVal FilePath As String, ByVal AppPool As String, ByVal DefaultLogonDomain As String) As String

‘ need to validate the NEW hostheaders first
Dim WebServiceObj As DirectoryEntry
Dim siteexists As Boolean
Dim Sites As DirectoryEntries
Dim objSITE As DirectoryEntry
Dim Newwebserver As DirectoryEntry
Dim objIIS As DirectoryEntry
Dim objVirtualDirectory As DirectoryEntry
Dim headers() As String
Dim counter As Int16headers = Split(Hosts, “,”)Try

WebServiceObj = New DirectoryEntry(“IIS://” & StrMachine & “/W3SVC”)
siteexists = False
For Each objSITE In WebServiceObj.Children
‘not all object in collection are web sites, so need to test BEFORE drilling into hosts property
   If UCase(objSITE.SchemaClassName) = “IISWEBSERVER” Then
      If UCase(objSITE.Path.ToString) = UCase(“IIS://” & StrMachine & “/W3SVC/” & StrSitenumber) Then ’site already exists
         siteexists = True
      End If
   End If
Next

If siteexists Then
   Newwebserver = New DirectoryEntry(“IIS://” & StrMachine & “/W3SVC/” & StrSitenumber)
   createsite = “Site Already exists”
Else
   Newwebserver = WebServiceObj.Children.Add(StrSitenumber, “IIsWebServer”)
   createsite = “Create New Site”
End If

Newwebserver.Properties(“ServerComment”).Item(0) = StrSiteDesc
For counter = 0 To UBound(headers)
   Newwebserver.Properties(“ServerBindings”).Add(“:80:” & headers(counter))
Next
Newwebserver.CommitChanges()
Newwebserver = Nothing
objIIS = New DirectoryEntry(“IIS://” & StrMachine & “/W3SVC/” & StrSitenumber)
siteexists = False

For Each objSITE In objIIS.Children ‘ check each object in site, if Vdir is it called root
‘not all object in collection are web sites, so need to test BEFORE drilling into propertys
   If UCase(objSITE.SchemaClassName) = “IISWEBVIRTUALDIR” Then
      If UCase(objSITE.Path.ToString) = UCase(“IIS://” & StrMachine & “/W3SVC/” & StrSitenumber & “/ROOT”) Then ’site already exists
         siteexists = True
      End If
   End If
Next

If siteexists Then ‘Connection to exitsing site
   objVirtualDirectory = New DirectoryEntry(“IIS://” & StrMachine & “/W3SVC/” & StrSitenumber & “/Root”)
Else ‘ create NEW one 
   objVirtualDirectory = objIIS.Children.Add(“Root”, “IISWebVirtualDir”)
   createsite = “Site Created”
End If

‘fix all the properties

   objVirtualDirectory.Properties(“AccessScript”).Item(0) = True
   objVirtualDirectory.Properties(“Path”).Item(0) = FilePath
   objVirtualDirectory.Properties(“AnonymousUserName”).Item(0) = IwamUser
   objVirtualDirectory.Properties(“AnonymousUserPass”).Item(0) = IWamPass
   objVirtualDirectory.Properties(“AnonymousPasswordSync”).Item(0) = False
   objVirtualDirectory.Properties(“DefaultLogonDomain”).Item(0) = DefaultLogonDomain
   objVirtualDirectory.Properties(“AppFriendlyName”).Item(0) = AppPool
   objVirtualDirectory.Properties(“AppIsolated”).Item(0) = 2
   objVirtualDirectory.Properties(“AppPoolId”).Item(0) = AppPool
   objVirtualDirectory.Properties(“AccessWrite”).Item(0) = False
   objVirtualDirectory.Properties(“AccessRead”).Item(0) = True
   objVirtualDirectory.Properties(“AccessExecute”).Item(0) = True
   objVirtualDirectory.Properties(“AccessScript”).Item(0) = True
   objVirtualDirectory.Properties(“AuthAnonymous”).Item(0) = True
   objVirtualDirectory.Properties(“AuthBasic”).Item(0) = True
   objVirtualDirectory.Invoke(“AppCreate”, True)
   objVirtualDirectory.CommitChanges() Catch ex As Exception‘createsite = ex.Message

Finally

   WebServiceObj = Nothing
   siteexists = Nothing
   Sites = Nothing
   objSITE = Nothing
   Newwebserver = Nothing
   objIIS = Nothing
   objVirtualDirectory = NothingEnd Try

End Function