分享
 
 
 

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

王朝vb·作者佚名  2006-12-16
窄屏简体版  字體: |||超大  

创建虚拟目录 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 unable to create new web server. Server number is "&Index&"."

WScript.Quit (1)

End If

Wend

End If

NewBindings = Array(0)

NewBindings(0) = BindingString

NewWebServer.ServerBindings = NewBindings

NewWebServer.ServerComment = ServerComment

NewWebServer.SetInfo

' Now create the root directory object.

Trace "Setting the home directory..."

Set NewDir = NewWebServer.Create("IIsWebVirtualDir", "ROOT")

NewDir.Path = RootDirectory

NewDir.AccessRead = true

Err.Clear

NewDir.SetInfo

NewDir.AppCreate (True)

If (Err.Number = 0) Then

Trace "Home directory set."

Else

Display "Error setting home directory."

End If

Trace "Web site created!"

If Start = True Then

Trace "Attempting to start new web server..."

Err.Clear

Set NewWebServer = GetObject("IIS://" & comp & "/w3svc/" & Index)

NewWebServer.Start

If Err.Number <> 0 Then

Display "Error starting web server!"

Err.Clear

Else

Trace "Web server started succesfully!"

End If

End If

Next

Call ASTSetPerms(comp, Index,ArgRootDirectory , prop, propNum)

End Sub

Sub ASTSetPerms(comp, ArgSiteNumber,ArgRootDirectory , propList, propCount)

'On Error Resume Next

Dim oAdmin

Dim fullPath

fullPath = "IIS://"&comp&"/w3svc/" & ArgSiteNumber & "/ROOT"

Trace "Opening path " & fullPath

Set oAdmin = GetObject(fullPath)

If Err.Number <> 0 Then

Display Error_NoNode

WScript.Quit (1)

End If

Dim name, val

if propCount > 0 then

Dim i

for i = 0 to propCount-1

name = propList(i,0)

val = propList(i,1)

if verbose = true then

Trace "Setting "&fullPath&"/"&name&" = "& val

end if

oAdmin.Put name, (val)

If Err <> 0 Then

Display "Unable to set property "&name

End If

next

oAdmin.SetInfo

If Err <> 0 Then

Display "不能保存更新信息."

End If

end if

End Sub

' Display the usage message

Sub DisplayUsage

WScript.Quit (1)

End Sub

Sub Display(Msg)

WScript.Echo Now & ". Error Code: " & Hex(Err) & " - " & Msg

End Sub

Sub Trace(Msg)

if verbose = true then

WScript.Echo Now & " : " & Msg

end if

End Sub

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有