改进后的mkw3site.vbs(创建虚拟目录)

答案：//////////////////////////
作者：Jaron, 江都资讯网 
邮件：jaron@jdinfo.net
网址：http://www.jiangdu.net
本文首次发表于 jiangdu.net ,如果您要转载该文章，请注明出处。
////////////////////////// 

'---------------------------------------------------------------------------------------------------
' 创建虚拟目录  POWER BY JARON , 江都资讯网 , 1999-2002. 
' 如果您需要设置权限，请修改40-56 的代码。 ** 根据 Microsoft Corp. 的 AdminScripts 改写
'
' 用法: mkw3site <--RootDirectory|-r ROOT DIRECTORY>
'                         <--Comment|-t SERVER COMMENT>
'                         [--computer|-c COMPUTER1[,COMPUTER2...]]
'                         [--HostName|-h HOST NAME]
'                         [--port|-o PORT NUM]
'                         [--IPAddress|-i IP ADDRESS]
'                         [--SiteNumber|-n SITENUMBER]
'                         [--DontStart]
'                         [--verbose|-v]
'                         [--help|-?]
'
' IP ADDRESS            The IP Address to assign to the new server.  Optional.
' HOST NAME             The host name of the web site for host headers.
'WARNING: Only use Host Name if DNS is set up find the server.
' PORT NUM              The port to which the server should bind
' ROOT DIRECTORY        Full path to the root directory for the new server.
' SERVER COMMENT        The server comment -- this is the name that appers in the MMC.
' SITENUMBERThe Site Number is the number in the path that the web server
'will be created at.  i.e. w3svc/3
'
' Example 1: mkw3site -r D:\Roots\Company11 --DontStart -t "My Company Site"
' Example 2: mkw3site -r C:\Inetpub\wwwroot -t Test -o 8080
'------------------------------------------------------------------------------------------------ 


' Force explicit declaration of all variables
Option Explicit 

On Error Resume Next 

Dim ArgIPAddress, ArgRootDirectory, ArgServerComment, ArgSkeletalDir, ArgHostName, ArgPort
Dim ArgComputers, ArgStart
Dim ArgSiteNumber
Dim oArgs, ArgNum
Dim verbose
' 设置可写、脚本执行权限
Dim prop(15,2)
Dim propNum
prop(propNum,0) = "AccessRead"
prop(propNum,1) = true' 可读设为TRUE,不可读设为FALSE
propNum = propNum + 1
prop(propNum, 0) = "AccessWrite"
prop(propNum, 1) = true ' 可写设为TRUE,不可写设为FALSE
propNum = propNum + 1
prop(propNum, 0) = "AccessScript"
prop(propNum, 1) = true ' 可运行脚本文件设为TRUE,不可运行脚本文件设为FALSE
propNum = propNum + 1
prop(propNum, 0) = "AccessExecute"
prop(propNum, 1) = false ' 可运行执行文件设为TRUE,不可运行执行文件设为FALSE
propNum = propNum + 1
prop(propNum, 0) = "EnableDirBrowsing"
prop(propNum, 1) = true ' 允许列出目录设为TRUE,不允许列出目录设为FALSE
propNum = propNum + 1 

ArgIPAddress = ""
ArgHostName = ""
ArgPort = 80
ArgStart = True
ArgComputers = Array(1)
ArgComputers(0) = "LocalHost"
ArgSiteNumber = 0
verbose = false 

Set oArgs = WScript.Arguments
ArgNum = 0 

While ArgNum < oArgs.Count 

Select Case LCase(oArgs(ArgNum))
Case "--port","-o":
ArgNum = ArgNum + 1
ArgPort = oArgs(ArgNum)
Case "--ipaddress","-i":
ArgNum = ArgNum + 1
ArgIPAddress = oArgs(ArgNum)
Case "--rootdirectory","-r": 
ArgNum = ArgNum + 1
ArgRootDirectory = oArgs(ArgNum)
Case "--comment","-t":
ArgNum = ArgNum + 1
ArgServerComment = oArgs(ArgNum)
Case "--hostname","-h":
ArgNum = ArgNum + 1
ArgHostName = oArgs(ArgNum)
Case "--computer","-c":
ArgNum = ArgNum + 1
ArgComputers = Split(oArgs(ArgNum), ",", -1)
Case "--sitenumber","-n":
ArgNum = ArgNum + 1
ArgSiteNumber = CLng(oArgs(ArgNum))
Case "--dontstart":
ArgStart = False
Case "--help","-?":
Call DisplayUsage
Case "--verbose", "-v":
verbose = true
Case Else:
WScript.Echo "Unknown argument "& oArgs(ArgNum)
Call DisplayUsage
End Select 

ArgNum = ArgNum + 1
Wend 

If (ArgRootDirectory = "") Or (ArgServerComment = "") Then
if (ArgRootDirectory = "") then
WScript.Echo "Missing Root Directory"
else
WScript.Echo "Missing Server Comment"
end if
Call DisplayUsage
WScript.Quit(1)
End If 

Call ASTCreateWebSite(ArgIPAddress, ArgRootDirectory, ArgServerComment, ArgHostName, ArgPort, ArgComputers, ArgStart) 

Sub ASTCreateWebSite(IPAddress, RootDirectory, ServerComment, HostName, PortNum, Computers, Start)
Dim w3svc, WebServer, NewWebServer, NewDir, Bindings, BindingString, NewBindings, ComputerIndex, Index, SiteObj, bDone
Dim comp
On Error Resume Next
For ComputerIndex = 0 To UBound(Computers)
comp = Computers(ComputerIndex)
If ComputerIndex <> UBound(Computers) Then
Trace "Creating web site on " & comp & "."
End If 

' Grab the web service object
Err.Clear
Set w3svc = GetObject("IIS://" & comp & "/w3svc")
If Err.Number <> 0 Then
Display "Unable to open: "&"IIS://" & comp & "/w3svc"
End If
BindingString = IpAddress & ":" & PortNum & ":" & HostName
Trace "Making sure this web server doesn't conflict with another..."
For Each WebServer in w3svc
If WebServer.Class = "IIsWebServer" Then
Bindings = WebServer.ServerBindings
If BindingString = Bindings(0) Then
Trace "The server bindings you specified are duplicated in another virtual web server."
WScript.Quit (1)
End If
End If
Next 

Index = 1
bDone = False
Trace "Creating new web server..." 

' If the user specified a SiteNumber, then use that.  Otherwise,
' test successive numbers under w3svc until an unoccupied slot is found
If ArgSiteNumber <> 0 Then
Set NewWebServer = w3svc.Create("IIsWebServer", ArgSiteNumber)
NewWebServer.SetInfo
If (Err.Number <> 0) Then
WScript.Echo "Couldn't create a web site with the specified number: " & ArgSiteNumber
WScript.Quit (1)
Else
Err.Clear
' Verify that the newly created site can be retrieved
Set SiteObj = GetObject("IIS://"&comp&"/w3svc/" & ArgSiteNumber)
If (Err.Number = 0) Then
bDone = True
Trace "Web server created. Path is - "&"IIS://"&comp&"/w3svc/" & ArgSiteNumber
Else
WScript.Echo "Couldn't create a web site with the specified number: " & ArgSiteNumber
WScript.Quit (1)
End If
End If
Else
While (Not bDone)
Err.Clear
Set SiteObj = GetObject("IIS://"&comp&"/w3svc/" & Index) 

If (Err.Number = 0) Then
' A web server is already defined at this position so increment
Index = Index + 1
Else
Err.Clear
Set NewWebServer = w3svc.Create("IIsWebServer", Index)
NewWebServer.SetInfo
If (Err.Number <> 0) Then
' If call to Create failed then try the next number
Index = Index + 1
Else
Err.Clear
' Verify that the newly created site can be retrieved
Set SiteObj = GetObject("IIS://"&comp&"/w3svc/" & Index)
If (Err.Number = 0) Then
bDone = True
Trace "Web server created. Path is - "&"IIS://"&comp&"/w3svc/" & Index
Else
Index = Index + 1
End If
End If
End If 

' sanity check
If (Index > 10000) Then
Trace "Seem to be una

上一个：编译 asp 应用程序
下一个：用VBS修改IIS Metabase