iis « BrakertechBrakertech

IIS 6.0 Add Host Headers in Bulk

posted this in IIS, Windows on February 23rd, 2012

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

1	AppendHostHeaders.vbs

chglist.vbs

1	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

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/" &amp; objID &amp; "/ServerBindings | find /C "  &amp; chr(34) &amp; objSite  &amp; chr(34) &amp;  " > 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;" &amp; _
    "Data Source=" &amp; strPathtoTextFile &amp; ";" &amp; _
    "Extended Properties=""text;HDR=YES;FMT=Delimited"""

adoCSVRecordset.Open "SELECT * FROM " &amp; 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 _
        '    &amp; " = " &amp; 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/" &amp; id &amp; "/ServerBindings FIRST " &amp; chr(34) &amp; ":80:" &amp; sitename &amp; chr(34) &amp; " /INSERT /COMMIT"
			Set objShell = CreateObject("WScript.Shell")
			objShell.run commandToRun, 0, true
			Wscript.Echo "site: " &amp; id &amp; "  -- Added " &amp; sitename
		Else
			Wscript.Echo "site: " &amp; id &amp; "  -- Already Exists " &amp; sitename
		End If
    else
		Wscript.Echo "sitename: " &amp; sitename &amp; "is too short"

	end if
    id = ""
    sitename = ""
    commandToRun = ""
    adoCSVRecordset.MoveNext
Loop

' Clean up.
adoCSVRecordset.Close
adoCSVConnection.Close

100

101

102

103

104

105

106

107

108

109

' 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

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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

280

281

282

283

284

285

286

287

288

289

290

291

292

293

294

295

296

297

298

299

300

301

302

303

304

305

306

307

308

309

310

311

312

313

314

315

316

317

318

319

320

321

322

323

324

325

326

327

328

329

330

331

332

333

334

335

336

337

338

339

340

341

342

343

344

345

346

347

348

349

350

351

352

353

354

355

356

357

358

359

360

361

362

363

364

365

366

367

368

369

370

371

372

373

374

375

376

377

378

379

380

381

382

383

384

385

386

387

388

389

390

391

392

' 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

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 /

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

PerformedOperation = 1

Else

Operation = ""

objNewArray( j ) = objElement

j = j + 1

End If

LogVerbose Operation & objElement

' 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 )

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

If ( bRecurse = true ) Then

For Each objElement In objNode

LogEcho ""

HandleListOps = HandleListOps( OpType, NormalizePath( Mid( objElement.AdsPath, Len( strNamespace ) + 1 ) ), strPropertyName, strPropertyExistValue, strPropertyNewValue, bRecurse )

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

. . . → Read More: IIS 6.0 Add Host Headers in Bulk

Howto: Print Site IDs to File in IIS

posted this in IIS, Windows on August 24th, 2010

First create a file called c:\listsites.vbs with the following content:

OPTION EXPLICIT                                                                 
                                                                                
DIM CRLF, TAB                                                                   
DIM strServer                                                                   
DIM objWebService                                                               
                                                                                
TAB  = CHR( 9 )                                                                 
CRLF = CHR( 13 ) & CHR( 10 )                                                    
                                                                                
IF WScript.Arguments.Length = 1 THEN                                            
    strServer = WScript.Arguments( 0 )                                          
ELSE                                                                            
    strServer = "localhost"                                                     
END IF                                                                          
                                                                                
WScript.Echo "Enumerating websites on " & strServer & CRLF                      
SET objWebService = GetObject( "IIS://" & strServer & "/W3SVC" )                
EnumWebsites objWebService                                                      
                                                                                
                                                                                
SUB EnumWebsites( objWebService )                                               
    DIM objWebServer, strBindings                                               
                                                                                
    FOR EACH objWebServer IN objWebService                                      
        IF objWebserver.Class = "IIsWebServer" THEN                             
            WScript.Echo _                                                      
                "Site ID = " & objWebserver.Name & CRLF & _                     
                "Comment = """ & objWebServer.ServerComment & """ " & CRLF & _  
                "State   = " & State2Desc( objWebserver.ServerState ) & CRLF & _
                "LogDir  = " & objWebServer.LogFileDirectory & _                
                ""                                                              
                                                                                
            ' Enumerate the HTTP bindings (ServerBindings) and                  
            ' SSL bindings (SecureBindings)                                     
            strBindings = EnumBindings( objWebServer.ServerBindings ) & _       
                          EnumBindings( objWebServer.SecureBindings )           
            IF NOT strBindings = "" THEN                                        
                WScript.Echo "IP Address" & TAB & _                             
                             "Port" & TAB & _                                   
                             "Host" & CRLF & _                                  
                             strBindings                                        
            END IF                                                              
        END IF                                                                  
    NEXT                                                                        
                                                                                
END SUB                                                                         
                                                                                
FUNCTION EnumBindings( objBindingList )                                         
    DIM i, strIP, strPort, strHost                                              
    DIM reBinding, reMatch, reMatches                                           
    SET reBinding = NEW RegExp                                                  
    reBinding.Pattern = "([^:]*):([^:]*):(.*)"                                  
                                                                                
    FOR i = LBOUND( objBindingList ) TO UBOUND( objBindingList )                
        ' objBindingList( i ) is a string looking like IP:Port:Host             
        SET reMatches = reBinding.Execute( objBindingList( i ) )                
        FOR EACH reMatch IN reMatches                                           
            strIP = reMatch.SubMatches( 0 )                                     
            strPort = reMatch.SubMatches( 1 )                                   
            strHost = reMatch.SubMatches( 2 )                                   
                                                                                
            ' Do some pretty processing                                         
            IF strIP = "" THEN strIP = "All Unassigned"                         
            IF strHost = "" THEN strHost = "*"                                  
            IF LEN( strIP ) < 8 THEN strIP = strIP & TAB                        
                                                                                
            EnumBindings = EnumBindings & _                                     
                           strIP & TAB & _                                      
                           strPort & TAB & _                                    
                           strHost & TAB & _                                    
                           ""                                                   
        NEXT                                                                    
                                                                                
        EnumBindings = EnumBindings & CRLF                                      
    NEXT                                                                        
                                                                                
END FUNCTION                                                                    
                                                                                
FUNCTION State2Desc( nState )                                                   
    SELECT CASE nState                                                          
    CASE 1                                                                      
        State2Desc = "Starting (MD_SERVER_STATE_STARTING)"                      
    CASE 2                                                                      
        State2Desc = "Started (MD_SERVER_STATE_STARTED)"                        
    CASE 3                                                                      
        State2Desc = "Stopping (MD_SERVER_STATE_STOPPING)"                      
    CASE 4                                                                      
        State2Desc = "Stopped (MD_SERVER_STATE_STOPPED)"                        
    CASE 5                                                                      
        State2Desc = "Pausing (MD_SERVER_STATE_PAUSING)"                        
    CASE 6                                                                      
        State2Desc = "Paused (MD_SERVER_STATE_PAUSED)"                          
    CASE 7                                                                      
        State2Desc = "Continuing (MD_SERVER_STATE_CONTINUING)"                  
    CASE ELSE                                                                   
        State2Desc = "Unknown state"                                            
    END SELECT
END FUNCTION

OPTION EXPLICIT

DIM CRLF, TAB

DIM strServer

DIM objWebService

TAB = CHR( 9 )

CRLF = CHR( 13 ) & CHR( 10 )

IF WScript.Arguments.Length = 1 THEN

strServer = WScript.Arguments( 0 )

ELSE

strServer = "localhost"

END IF

WScript.Echo "Enumerating websites on " & strServer & CRLF

SET objWebService = GetObject( "IIS://" & strServer & "/W3SVC" )

EnumWebsites objWebService

SUB EnumWebsites( objWebService )

DIM objWebServer, strBindings

FOR EACH objWebServer IN objWebService

IF objWebserver.Class = "IIsWebServer" THEN

WScript.Echo _

"Site ID = " & objWebserver.Name & CRLF & _

"Comment = """ & objWebServer.ServerComment & """ " & CRLF & _

"State = " & State2Desc( objWebserver.ServerState ) & CRLF & _

"LogDir = " & objWebServer.LogFileDirectory & _

' Enumerate the HTTP bindings (ServerBindings) and

' SSL bindings (SecureBindings)

strBindings = EnumBindings( objWebServer.ServerBindings ) & _

EnumBindings( objWebServer.SecureBindings )

IF NOT strBindings = "" THEN

WScript.Echo "IP Address" & TAB & _

"Port" & TAB & _

"Host" & CRLF & _

strBindings

END IF

END SUB

FUNCTION EnumBindings( objBindingList )

DIM i, strIP, strPort, strHost

DIM reBinding, reMatch, reMatches

SET reBinding = NEW RegExp

reBinding.Pattern = "([^:]*):([^:]*):(.*)"

FOR i = LBOUND( objBindingList ) TO UBOUND( objBindingList )

' objBindingList( i ) is a string looking like IP:Port:Host

SET reMatches = reBinding.Execute( objBindingList( i ) )

FOR EACH reMatch IN reMatches

strIP = reMatch.SubMatches( 0 )

strPort = reMatch.SubMatches( 1 )

strHost = reMatch.SubMatches( 2 )

' Do some pretty processing

IF strIP = "" THEN strIP = "All Unassigned"

IF strHost = "" THEN strHost = "*"

IF LEN( strIP ) < 8 THEN strIP = strIP & TAB

EnumBindings = EnumBindings & _

strIP & TAB & _

strPort & TAB & _

strHost & TAB & _

EnumBindings = EnumBindings & CRLF

END FUNCTION

FUNCTION State2Desc( nState )

SELECT CASE nState

CASE 1

State2Desc = "Starting (MD_SERVER_STATE_STARTING)"

CASE 2

State2Desc = "Started (MD_SERVER_STATE_STARTED)"

CASE 3

State2Desc = "Stopping (MD_SERVER_STATE_STOPPING)"

CASE 4

State2Desc = "Stopped (MD_SERVER_STATE_STOPPED)"

CASE 5

State2Desc = "Pausing (MD_SERVER_STATE_PAUSING)"

CASE 6

State2Desc = "Paused (MD_SERVER_STATE_PAUSED)"

CASE 7

State2Desc = "Continuing (MD_SERVER_STATE_CONTINUING)"

CASE ELSE

State2Desc = "Unknown state"

END SELECT

END FUNCTION

Create another file called listsites.bat (anywhere) with this content:

cscript c:\listsites.vbs > c:\listsites.txt
C:\WINDOWS\NOTEPAD.EXE c:\listsites.txt

1 2	cscript c:\listsites.vbs > c:\listsites.txt C:\WINDOWS\NOTEPAD.EXE c:\listsites.txt

Brakertech

IIS 6.0 Add Host Headers in Bulk

Run IIS6 in 32 bit mode

Howto: Migrate IIS Sites to Another Server

Howto: Change siteid of website in IIS 6.0

Howto: Fix Microsoft IIS Internal IP Address Disclosure Vulnerability With Scripts

Search Brakertech

dEFENSE

Hacking

Security

Brakertech

IIS 6.0 Add Host Headers in Bulk

Run IIS6 in 32 bit mode

Howto: Print Site IDs to File in IIS

Howto: Migrate IIS Sites to Another Server

Howto: Change siteid of website in IIS 6.0

Howto: Fix Microsoft IIS Internal IP Address Disclosure Vulnerability With Scripts

Search Brakertech

dEFENSE

Hacking

Tags

Security