IIS 6.0 Add Host Headers in Bulk
To add host headers in bulk (IIS 6.0) you will need these two scripts in C:\Inetpub\AdminScripts:
-
AppendHostHeaders.vbs
-
chglist.vbs
Additionally you will need an input csv called “c:\sites.csv” that follows this format (id, sitename must be first line):
id, sitename 1, www.test.com 2042610413, www2.two.testing.com 2042610413, www2.two.www.test.com 1, www.testing.com
Script: AppendHostHeaders.vbs
' AppendHostHeaders.vbs
' VBScript program to read a comma delimited file with a header line.
' Host headers will be added to all website identifiers listed in csv file
' If host header alredy exists no action will be taken for that line
'
' Script must be placed in C:\Inetpub\AdminScripts
' chglist.vbs must also exist in C:\Inetpub\AdminScripts
'
' Example Input file:
'id, sitename
'1, www.test.com
'2042610413, www2.two.testing.com
'2042610413, www2.two.www.test.com
'1, www.testing.com
'
' If your csv files does not live at c:\sites.csv please modify
' file to the correct path of your websites
'
Option Explicit
Dim adoCSVConnection, adoCSVRecordSet, strPathToTextfile
Dim strCSVFile, k
Dim id, sitename, commandToRun
Dim objShell, returnVal
' Specify path to CSV file.
strPathToTextFile = "c:\"
' Specify CSV file name.
strCSVFile = "sites.csv"
''''' This function will determine if the host header already exists for a site
''''
'''' usage:
'''' Dim returnVal
'''' returnVal = doesHostExist (1, "Host.domain.com")
''''
'''' if host exists a 1 will return
''''
'''' otherwise a 0 or nothing will return
Function doesHostExist ( objID, objSite )
Dim commandToRun, objFSO, objTextFile, strText
Set objShell = CreateObject("WScript.Shell")
commandToRun= "cmd /c adsutil.vbs GET W3SVC/" & objID & "/ServerBindings | find /C " & chr(34) & objSite & chr(34) & " > c:\temp\1.txt"
objShell.run commandToRun, 0, true
Const ForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile _
("c:\temp\1.txt", ForReading)
strText = objTextFile.ReadAll
objTextFile.Close
doesHostExist=strText
End Function
''''''
' Open connection to the CSV file.
'Microsoft.ACE.OLEDB.12.0
Set adoCSVConnection = CreateObject("ADODB.Connection")
Set adoCSVRecordSet = CreateObject("ADODB.Recordset")
' Open CSV file with header line.
adoCSVConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strPathtoTextFile & ";" & _
"Extended Properties=""text;HDR=YES;FMT=Delimited"""
adoCSVRecordset.Open "SELECT * FROM " & strCSVFile, adoCSVConnection
' Read the CSV file.
Do Until adoCSVRecordset.EOF
' Display all fields by name.
For k = 0 To adoCSVRecordset.Fields.Count - 1
'Wscript.Echo adoCSVRecordset.Fields(k).Name _
' & " = " & adoCSVRecordset.Fields(k).Value
If adoCSVRecordset.Fields(k).Name = "id" Then id = adoCSVRecordset.Fields(k).Value
If adoCSVRecordset.Fields(k).Name = "sitename" Then sitename = adoCSVRecordset.Fields(k).Value
Next
returnVal = ""
returnVal = doesHostExist (id, sitename)
if len(sitename) > 5 then
If CBool(returnVal) = false Then
commandToRun= "cscript chglist.vbs W3SVC/" & id & "/ServerBindings FIRST " & chr(34) & ":80:" & sitename & chr(34) & " /INSERT /COMMIT"
Set objShell = CreateObject("WScript.Shell")
objShell.run commandToRun, 0, true
Wscript.Echo "site: " & id & " -- Added " & sitename
Else
Wscript.Echo "site: " & id & " -- Already Exists " & sitename
End If
else
Wscript.Echo "sitename: " & sitename & "is too short"
end if
id = ""
sitename = ""
commandToRun = ""
adoCSVRecordset.MoveNext
Loop
' Clean up.
adoCSVRecordset.Close
adoCSVConnection.Close
Script chglist.vbs
' Allows append/insert/remove of specific elements from an IIS "List" type node
' i.e. ScriptMap, HttpError, ServerBindings
'
' Origin : http://blogs.msdn.com/David.Wang/archive/2004/12/02/273681.aspx
' Version: December 1 2004
'
Option Explicit
On Error Resume Next
const ERROR_SUCCESS = 0
const ERROR_PATH_NOT_FOUND = 3
const ERROR_INVALID_PARAMETER = 87
const LIST_OP_FIRST = "FIRST"
const LIST_OP_LAST = "LAST"
const LIST_OPTION_REPLACE = 0
const LIST_OPTION_INSERT = 1
const LIST_OPTION_REMOVE = 2
const LIST_OPTION_ALL = 4
const LIST_OPTION_RECURSE = 8
Dim CRLF
CRLF = CHR(13) & CHR(10)
Dim strHelp
strHelp = "Edit/Replace IIS metabase LIST properties" & CRLF &_
CRLF &_
WScript.ScriptName & " PropertyPath ExistValue NewValue [Options]" & CRLF &_
CRLF &_
"Where:" & CRLF &_
" PropertyPath IIS metabase property path whose data type is LIST." & CRLF &_
" i.e. W3SVC/ScriptMaps, W3SVC/HttpErrors" & CRLF &_
" ExistValue Value to case-insensitive literal match against existing" & CRLF &_
" LIST elements." & CRLF &_
" FIRST - matches the first LIST element." & CRLF &_
" LAST - matches the last LIST element." & CRLF &_
" NewValue New value that replaces the matched the LIST element." & CRLF &_
"Options:" & CRLF &_
" /INSERT Insert before LIST element matching ." & CRLF &_
" /REMOVE Remove LIST element matching ." & CRLF &_
" /ALL Operate on ALL matching . Default is first match." & CRLF &_
" /REGEXP Use as RegExp to match. Default is literal." & CRLF &_
" /RECURSE Recursively perform the operation underneath ." & CRLF &_
" /VERBOSE Give more status/output." & CRLF &_
" /COMMIT Actually perform changes. Default only shows." & CRLF &_
""
dim Debug
Debug = true
dim Verbose
Verbose = false
dim reMatch
reMatch = false
Dim strServer
Dim strNamespace
Dim strSchemaNamespace
Dim strNodeSyntax
Dim objNode
Dim nOperationType
Dim strNormalizedPath
Dim strPropertyPath
Dim strPropertyName
Dim strPropertyExistValue
Dim strPropertyNewValue
Dim i,j
'
' Start of script
'
strServer = "localhost"
strNamespace = "IIS://" & strServer
strSchemaNamespace = strNamespace & "/" & "Schema"
'
' Parse the commandline
'
If WScript.Arguments.Count < 3 Then
Err.Number = ERROR_INVALID_PARAMETER
HandleError "Insufficient number of arguments." & CRLF &_
CRLF &_
strHelp &_
""
End If
nOperationType = LIST_OPTION_REPLACE
For i = 0 To WScript.Arguments.Count - 1
Select Case UCase( WScript.Arguments( i ) )
Case "/INSERT"
nOperationType = nOperationType Or LIST_OPTION_INSERT
Case "/REMOVE"
nOperationType = nOperationType Or LIST_OPTION_REMOVE
Case "/ALL"
nOperationType = nOperationType Or LIST_OPTION_ALL
Case "/RECURSE"
nOperationType = nOperationType Or LIST_OPTION_RECURSE
Case "/COMMIT"
Debug = false
Case "/VERBOSE"
Verbose = true
Case "/REGEXP"
reMatch = true
Case Else
If ( i = 0 ) Then
'
' Split out PropertyName and its ParentPath from PropertyPath
'
Err.Clear
strNormalizedPath = NormalizePath( WScript.Arguments( 0 ) )
HandleError "Failed to normalize PropertyPath."
j = InstrRev( strNormalizedPath, "/", -1, 0 )
If ( j = 0 Or j = 1 ) Then
Err.Number = ERROR_PATH_NOT_FOUND
HandleError "Invalid PropertyPath."
End If
Err.Clear
strPropertyPath = NormalizePath( Mid( strNormalizedPath, 1, j - 1 ) )
HandleError "Failed to retrieve/normalize PropertyPath."
Err.Clear
strPropertyName = NormalizePath( Mid( strNormalizedPath, j + 1 ) )
HandleError "Failed to retrieve/normalize PropertyName."
ElseIf ( i = 1 ) Then
'
' The existing match value
'
strPropertyExistValue = Replace( UCase( WScript.Arguments( 1 ) ), "``", """" )
ElseIf ( i = 2 ) Then
'
' The new replace value
'
strPropertyNewValue = Replace( WScript.Arguments( 2 ), "``", """" )
Else
Err.Number = ERROR_INVALID_PARAMETER
HandleError "Unknown parameter " & WScript.Arguments( i ) & CRLF &_
CRLF &_
strHelp &_
""
End If
End Select
Next
LogVerbose "OpType = " & nOperationType
LogVerbose "PropertyPath = " & strPropertyPath
LogVerbose "PropertyName = " & strPropertyName
LogVerbose "ExistValue = " & strPropertyExistValue
LogVerbose "NewValue = " & strPropertyNewValue
'
' Check the data type for the given property
' If it is not LIST, do not process any further
'
Err.Clear
Set objNode = GetObject( strSchemaNamespace & "/" & strPropertyName )
HandleError "Cannot read schema for property " & strPropertyName
strNodeSyntax = UCase( objNode.Syntax )
LogVerbose "Syntax = " & strNodeSyntax
LogVerbose ""
Select Case strNodeSyntax
Case "LIST"
'
' Finally, we are ready to do some real work
'
Err.Clear
Err.Number = HandleListOps( nOperationType, strPropertyPath, strPropertyName, strPropertyExistValue, strPropertyNewValue, ( nOperationType And LIST_OPTION_RECURSE ) <> 0 )
HandleError ""
Case Else
Err.Clear
Err.Number = ERROR_PATH_NOT_FOUND
HandleError "Cannot handle " & strPropertyPath & "/" & strPropertyName & " with type " & strNodeSyntax
End Select
'
' End of script
'
'
' Sub routines and functions
'
Sub HandleError( errorDescription )
If ( Err.Number <> 0 ) Then
If ( IsEmpty( errorDescription ) ) Then
LogEcho Err.Description
Else
LogEcho errorDescription
End If
WScript.Quit Err.Number
End If
End Sub
Function NormalizePath( strInput )
'
' Replace all \ with /
'
strInput = Replace( strInput, "\", "/", 1, -1 )
'
' Replace all // with /
'
Do
strInput = Replace( strInput, "//", "/", 1, -1 )
Loop While ( Instr( strInput, "//" ) <> 0 )
'
' Removing leading and trailing /
'
If ( Left( strInput, 1 ) = "/" ) Then
strInput = Right( strInput, Len( strInput ) - 1 )
End If
If ( Right( strInput, 1 ) = "/" ) Then
strInput = Left( strInput, Len( strInput ) - 1 )
End If
NormalizePath = strInput
End Function
Function HandleListOps( OpType, strPropertyPath, strPropertyName, strPropertyExistValue, strPropertyNewValue, bRecurse )
On Error Resume Next
Dim objNode, objNodeAttribute
Dim objList
Dim objElement
Dim objNewArray
Dim PerformedOperation
Dim Operation
Dim re
Dim reMatched
Dim i, j
Err.Clear
Set objNode = GetObject( strNamespace & "/" & strPropertyPath )
objList = objNode.Get( strPropertyName )
If ( Err.Number <> 0 Or IsEmpty( objList ) ) Then
LogEcho "Failed to retrieve " & strPropertyPath & "/" & strPropertyName
HandleListOps = Err.Number
Exit Function
End If
Err.Clear
Set objNodeAttribute = objNode.GetPropertyAttribObj(strPropertyName)
HandleError "Failed to retrieve Attributes for " & strPropertyPath & "/" & strPropertyName
If ( objNodeAttribute.IsInherit = true ) Then
LogEcho strPropertyPath & "/" & strPropertyName & " (Inherited)"
If ( bRecurse = true ) Then
LogEcho( "Ignoring inherited property for Recursive Modification" )
Exit Function
End If
Else
LogEcho strPropertyPath & "/" & strPropertyName
End If
'
' j is the count of elements in objNewArray
' So that we can resize it to the right size in the end
'
j = 0
'
' Size objNewArray to maximum possible size up-front, later shrink it
'
Redim objNewArray( UBound( objList ) + UBound( objList ) + 1 )
'
' PerformedOperation indicates whether something has matched and already
' operated upon, in this session. Start with 'not yet' = 0
'
PerformedOperation = 0
'
' Setup the RegExp match based on the existing value to search for
'
Set re = new RegExp
re.Pattern = strPropertyExistValue
re.IgnoreCase = true
re.Global = true
'
' Do this test outside of IF conditional because on error resume next
' turns off failures due to incorrect Pattern
'
Err.Clear
reMatched = re.Test( objElement )
If ( Err.Number <> 0 Or reMatch = false ) Then
reMatched = false
End If
LogVerbose "Original:"
For i = LBound( objList ) To UBound( objList )
objElement = objList( i )
'LogVerbose i & "(" & j & ")" & ": " & objElement
If ( ( ( ( strPropertyExistValue = LIST_OP_FIRST ) And ( i = LBound( objList ) ) ) Or _
( ( strPropertyExistValue = LIST_OP_LAST ) And ( i = UBound( objList ) ) ) Or _
( ( reMatch = false ) And ( Instr( UCase( objElement ), strPropertyExistValue ) > 0 ) ) Or _
( reMatched = true ) _
) _
And _
( ( ( OpType And LIST_OPTION_ALL ) <> 0 ) Or ( PerformedOperation = 0 ) ) _
) Then
Operation = "Replace "
If ( ( OpType And LIST_OPTION_REMOVE ) <> 0 ) Then
'Don't copy this element for deletion
Operation = "Remove "
Else
objNewArray( j ) = strPropertyNewValue
j = j + 1
If ( ( OpType And LIST_OPTION_INSERT ) <> 0 ) Then
Operation = "Insert "
objNewArray( j ) = objElement
j = j + 1
End If
End If
PerformedOperation = 1
Else
Operation = ""
objNewArray( j ) = objElement
j = j + 1
End If
LogVerbose Operation & objElement
Next
'
' Resize the final array to the correct size prior to SetInfo
'
ReDim Preserve objNewArray( j - 1 )
LogVerbose "New:"
For i = LBound( objNewArray ) To UBound( objNewArray )
LogDebug i & ": " & objNewArray( i )
Next
If ( Debug = false ) Then
If ( PerformedOperation = 1 ) Then
Err.Clear
objNode.Put strPropertyName, objNewArray
objNode.SetInfo
HandleError "Failed to SetInfo " & strPropertyPath & "/" & strPropertyName
LogEcho "SUCCESS: Updated " & strPropertyPath & "/" & strPropertyName
Else
LogEcho "SUCCESS: Nothing to update"
End If
Else
If ( PerformedOperation = 1 ) Then
LogEcho "DEBUG: Matched. Did not SetInfo"
Else
LogEcho "SUCCESS: No Match. Did not SetInfo"
End If
End If
If ( bRecurse = true ) Then
For Each objElement In objNode
LogEcho ""
HandleListOps = HandleListOps( OpType, NormalizePath( Mid( objElement.AdsPath, Len( strNamespace ) + 1 ) ), strPropertyName, strPropertyExistValue, strPropertyNewValue, bRecurse )
Next
End If
HandleListOps = 0
End Function
Sub LogEcho( str )
WScript.Echo str
End Sub
Sub LogDebug( str )
If ( Debug = true ) Then
LogEcho str
End If
End Sub
Sub LogVerbose( str )
If ( Verbose = true ) Then
LogEcho str
End If
End Sub
This is also possible if they offer SEO as part of their service.
A dedicated rented machine can be rented for operating complex web
applications and for the multiple sites interconnected to your business.
What search results will offered up with unless you possess
a website or perhaps a blog to market your business.