手机
当前位置:查字典教程网 >脚本专栏 >vbs >CreateWeb.vbs 代码
CreateWeb.vbs 代码
摘要:'=====================================================================...

'==============================================================================

'

'The.NETPetShopBlueprintApplicationWebSiteSetup

'

'File:CreateWeb.vbs

'Date:November10,2001

'

'Createsanewvdirforthisproject.SetvNametonameoffolderondisk

'thatholdsthefiles.

'

'==============================================================================

'

'Copyright(C)2001MicrosoftCorporation

'

'==============================================================================

OptionExplicit

dimvPath

dimscriptPath

dimvName

vName="PetShop"'nameofwebtocreate

'*****************************************************************************

'

'1.CreatetheIISVirtualDirectory

'

'*****************************************************************************

'getcurrentpathtofolderandaddwebnametoit

scriptPath=left(Wscript.ScriptFullName,len(Wscript.ScriptFullName)-len(Wscript.ScriptName))

vPath=scriptPath&"Web"

'calltocreatevDir

CreateVDir(vPath)

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

'

'HelperFunctions

'

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

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'CreatesasingleVirtualDirectory(codetakenfrommkwebdir.vbsand

'changedforsinglevDircreation).

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

SubCreateVDir(vPath)

DimvRoot,vDir,webSite

OnErrorResumeNext

'getthelocalhostdefaultweb

setwebSite=findWeb("localhost","DefaultWebSite")

ifIsObject(webSite)=Falsethen

Display"UnabletolocatetheDefaultWebSite"

exitsub

else

'displaywebSite.name

endif

'gettheroot

setvRoot=webSite.GetObject("IIsWebVirtualDir","Root")

If(Err<>0)Then

Display"Unabletoaccessrootfor"&webSite.ADsPath

Exitsub

else

'displayvRoot.name

EndIF

'deleteexistingwebifneeded

vRoot.Delete"IIsWebVirtualDir",vName

vRoot.SetInfo

Err=0'reseterror

'createthenewweb

SetvDir=vRoot.Create("IIsWebVirtualDir",vName)

If(Err<>0)Then

Display"Unabletocreate"&vRoot.ADsPath&"/"&vName&"."

exitsub

else

'displayvdir.name

endif

'setpropertiesonthenewweb

vDir.AccessRead=true

vDir.Path=vPath

vDir.Accessflags=529

VDir.AppCreateFalse

If(Err<>0)Then

Display"Unabletobindpath"&vPath&"to"&vRoot.Name&"/"&vName&".Pathmaybeinvalid."

exitsub

endIf

'commitchanges

vDir.SetInfo

If(Err<>0)Then

Display"Unabletosavechangesfor"&vRoot.Name&"/"&vName&"."

exitsub

endif

'reportallok

WScript.EchoNow&""&vName&"virtualdirectory"&vRoot.Name&"/"&vname&"createdsuccessfully."

EndSub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'Findsthespecifiedweb.

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

FunctionfindWeb(computer,webname)

OnErrorResumeNext

Dimwebsvc,site

dimwebinfo

DimaBinding,binding

setwebsvc=GetObject("IIS://"&computer&"/W3svc")

if(Err<>0)then

exitfunction

endif

'Firsttrytoopenthewebname.

setsite=websvc.GetObject("IIsWebServer",webname)

if(Err=0)and(notisNull(site))then

if(site.class="IIsWebServer")then

'Herewefoundasitethatisawebserver.

setfindWeb=site

exitfunction

endif

endif

err.clear

foreachsiteinwebsvc

ifsite.class="IIsWebServer"then

'

'First,checktoseeiftheServerComment

'matches

'

Ifsite.ServerComment=webnameThen

setfindWeb=site

exitfunction

EndIf

aBinding=site.ServerBindings

if(IsArray(aBinding))then

ifaBinding(0)=""then

binding=Null

else

binding=getBinding(aBinding(0))

endif

else

ifaBinding=""then

binding=Null

else

binding=getBinding(aBinding)

endif

endif

ifIsArray(binding)then

if(binding(2)=webname)or(binding(0)=webname)then

setfindWeb=site

exitfunction

EndIf

endif

endif

next

EndFunction

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'Getsbindinginfo.

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

functiongetBinding(bindstr)

Dimone,two,ia,ip,hn

one=Instr(bindstr,":")

two=Instr((one+1),bindstr,":")

ia=Mid(bindstr,1,(one-1))

ip=Mid(bindstr,(one+1),((two-one)-1))

hn=Mid(bindstr,(two+1))

getBinding=Array(ia,ip,hn)

endfunction

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'Displayserrormessage.

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

SubDisplay(Msg)

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

EndSub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'Displayprogress/tracemessage.

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

SubTrace(Msg)

WScript.EchoNow&":"&Msg

EndSub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'Removetheweb.

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

SubDeleteWeb(WebServer,WebName)

'deletetheexsitingweb(ignoreerrorifmissing)

OnErrorResumeNext

DimvDir

display"deleting"&WebName

WebServer.Delete"IISWebVirtualDir",WebName

WebServer.SetInfo

IfErr=0Then

DISPLAY"WEB"&WebName&"deleted."

else

display"can'tfind"&webname

EndIf

EndSub

【CreateWeb.vbs 代码】相关文章:

用vbs脚本来关闭 HTML 页面的代码

用vbs实现cmd功能的代码

vbscript ms owc 封裝代码

FileSystemObject 示例代码

SendKeys clip.exe 发送中文的代码

encrypt.vbs 内容加密vbs实现代码

windows2003一句话开3389的vbs代码

iisweb.vbs iis网站管理脚本使用介绍

实现winrar密码破解的vbs代码

CMD和vbs修改 IP地址及DNS的实现代码

精品推荐
分类导航