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