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

'---------------------------------------------------------------------------------------------------

'创建虚拟目录POWERBYJARON,江都资讯网,1999-2002.

'如果您需要设置权限，请修改40-56的代码。**根据MicrosoftCorp.的AdminScripts改写

'用法:mkw3site<--RootDirectory|-rROOTDIRECTORY>

'<--Comment|-tSERVERCOMMENT>

'[--computer|-cCOMPUTER1[,COMPUTER2...]]

'[--HostName|-hHOSTNAME]

'[--port|-oPORTNUM]

'[--IPAddress|-iIPADDRESS]

'[--SiteNumber|-nSITENUMBER]

'[--DontStart]

'[--verbose|-v]

'[--help|-?]

'IPADDRESSTheIPAddresstoassigntothenewserver.Optional.

'HOSTNAMEThehostnameofthewebsiteforhostheaders.

'WARNING:OnlyuseHostNameifDNSissetupfindtheserver.

'PORTNUMTheporttowhichtheservershouldbind

'ROOTDIRECTORYFullpathtotherootdirectoryforthenewserver.

'SERVERCOMMENTTheservercomment--thisisthenamethatappersintheMMC.

'SITENUMBERTheSiteNumberisthenumberinthepaththatthewebserver

'willbecreatedat.i.e.w3svc/3

'Example1:mkw3site-rD:RootsCompany11--DontStart-t"MyCompanySite"

'Example2:mkw3site-rC:Inetpubwwwroot-tTest-o8080

'------------------------------------------------------------------------------------------------

'Forceexplicitdeclarationofallvariables

OptionExplicit

OnErrorResumeNext

DimArgIPAddress,ArgRootDirectory,ArgServerComment,ArgSkeletalDir,ArgHostName,ArgPort

DimArgComputers,ArgStart

DimArgSiteNumber

DimoArgs,ArgNum

Dimverbose

'设置可写、脚本执行权限

Dimprop(15,2)

DimpropNum

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

SetoArgs=WScript.Arguments

ArgNum=0

WhileArgNum<oArgs.Count

SelectCaseLCase(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","-?":

CallDisplayUsage

Case"--verbose","-v":

verbose=true

CaseElse:

WScript.Echo"Unknownargument"&oArgs(ArgNum)

CallDisplayUsage

EndSelect

ArgNum=ArgNum+1

Wend

If(ArgRootDirectory="")Or(ArgServerComment="")Then

if(ArgRootDirectory="")then

WScript.Echo"MissingRootDirectory"

else

WScript.Echo"MissingServerComment"

endif

CallDisplayUsage

WScript.Quit(1)

EndIf

CallASTCreateWebSite(ArgIPAddress,ArgRootDirectory,ArgServerComment,ArgHostName,ArgPort,ArgComputers,ArgStart)

SubASTCreateWebSite(IPAddress,RootDirectory,ServerComment,HostName,PortNum,Computers,Start)

Dimw3svc,WebServer,NewWebServer,NewDir,Bindings,BindingString,NewBindings,ComputerIndex,Index,SiteObj,bDone

Dimcomp

OnErrorResumeNext

ForComputerIndex=0ToUBound(Computers)

comp=Computers(ComputerIndex)

IfComputerIndex<>UBound(Computers)Then

Trace"Creatingwebsiteon"&comp&"."

EndIf

'Grabthewebserviceobject

Err.Clear

Setw3svc=GetObject("IIS://"&comp&"/w3svc")

IfErr.Number<>0Then

Display"Unabletoopen:"&"IIS://"&comp&"/w3svc"

EndIf

BindingString=IpAddress&":"&PortNum&":"&HostName

Trace"Makingsurethiswebserverdoesn'tconflictwithanother..."

ForEachWebServerinw3svc

IfWebServer.Class="IIsWebServer"Then

Bindings=WebServer.ServerBindings

IfBindingString=Bindings(0)Then

Trace"Theserverbindingsyouspecifiedareduplicatedinanothervirtualwebserver."

WScript.Quit(1)

EndIf

Index=1

bDone=False

Trace"Creatingnewwebserver..."

'IftheuserspecifiedaSiteNumber,thenusethat.Otherwise,

'testsuccessivenumbersunderw3svcuntilanunoccupiedslotisfound

IfArgSiteNumber<>0Then

SetNewWebServer=w3svc.Create("IIsWebServer",ArgSiteNumber)

NewWebServer.SetInfo

If(Err.Number<>0)Then

WScript.Echo"Couldn'tcreateawebsitewiththespecifiednumber:"&ArgSiteNumber

WScript.Quit(1)

Else

Err.Clear

'Verifythatthenewlycreatedsitecanberetrieved

SetSiteObj=GetObject("IIS://"&comp&"/w3svc/"&ArgSiteNumber)

If(Err.Number=0)Then

bDone=True

Trace"Webservercreated.Pathis-"&"IIS://"&comp&"/w3svc/"&ArgSiteNumber

Else

WScript.Echo"Couldn'tcreateawebsitewiththespecifiednumber:"&ArgSiteNumber

WScript.Quit(1)

EndIf

Else

While(NotbDone)

Err.Clear

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

If(Err.Number=0)Then

'Awebserverisalreadydefinedatthispositionsoincrement

Index=Index+1

Else

Err.Clear

SetNewWebServer=w3svc.Create("IIsWebServer",Index)

NewWebServer.SetInfo

If(Err.Number<>0)Then

'IfcalltoCreatefailedthentrythenextnumber

Index=Index+1

Else

Err.Clear

'Verifythatthenewlycreatedsitecanberetrieved

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

If(Err.Number=0)Then

bDone=True

Trace"Webservercreated.Pathis-"&"IIS://"&comp&"/w3svc/"&Index

Else

Index=Index+1

EndIf

'sanitycheck

If(Index>10000)Then

Trace"Seemtobeunabletocreatenewwebserver.Servernumberis"&Index&"."

WScript.Quit(1)

EndIf

Wend

EndIf

NewBindings=Array(0)

NewBindings(0)=BindingString

NewWebServer.ServerBindings=NewBindings

NewWebServer.ServerComment=ServerComment

NewWebServer.SetInfo

'Nowcreatetherootdirectoryobject.

Trace"Settingthehomedirectory..."

SetNewDir=NewWebServer.Create("IIsWebVirtualDir","ROOT")

NewDir.Path=RootDirectory

NewDir.AccessRead=true

Err.Clear

NewDir.SetInfo

NewDir.AppCreate(True)

If(Err.Number=0)Then

Trace"Homedirectoryset."

Else

Display"Errorsettinghomedirectory."

EndIf

Trace"Websitecreated!"

IfStart=TrueThen

Trace"Attemptingtostartnewwebserver..."

Err.Clear

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

NewWebServer.Start

IfErr.Number<>0Then

Display"Errorstartingwebserver!"

Err.Clear

Else

Trace"Webserverstartedsuccesfully!"

EndIf

CallASTSetPerms(comp,Index,ArgRootDirectory,prop,propNum)

EndSub

SubASTSetPerms(comp,ArgSiteNumber,ArgRootDirectory,propList,propCount)

'OnErrorResumeNext

DimoAdmin

DimfullPath

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

Trace"Openingpath"&fullPath

SetoAdmin=GetObject(fullPath)

IfErr.Number<>0Then

DisplayError_NoNode

WScript.Quit(1)

EndIf

Dimname,val

ifpropCount>0then

Dimi

fori=0topropCount-1

name=propList(i,0)

val=propList(i,1)

ifverbose=truethen

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

endif

oAdmin.Putname,(val)

IfErr<>0Then

Display"Unabletosetproperty"&name

EndIf

oAdmin.SetInfo

IfErr<>0Then

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

EndIf

endif

EndSub

'Displaytheusagemessage

SubDisplayUsage

WScript.Quit(1)

EndSub

SubDisplay(Msg)

WScript.EchoNow&".ErrorCode:"&Hex(Err)&"-"&Msg

EndSub

SubTrace(Msg)

ifverbose=truethen

WScript.EchoNow&":"&Msg

endif

EndSub