兴国资源网 Design By www.nnzcdc.com
'==============================================================================
'
' The .NET PetShop Blueprint Application WebSite Setup
'
' File: CreateWeb.vbs
' Date: November 10, 2001
'
' Creates a new vdir for this project. Set vName to name of folder on disk
' that holds the files.
'
'==============================================================================
'
' Copyright (C) 2001 Microsoft Corporation
'
'==============================================================================
Option Explicit
dim vPath
dim scriptPath
dim vName
vName="PetShop" ' name of web to create
' *****************************************************************************
'
' 1. Create the IIS Virtual Directory
'
' *****************************************************************************
' get current path to folder and add web name to it
scriptPath = left(Wscript.ScriptFullName,len(Wscript.ScriptFullName ) -len(Wscript.ScriptName))
vPath = scriptPath & "Web"
'call to create vDir
CreateVDir(vPath)
' ----------------------------------------------------------------------------
'
' Helper Functions
'
' -----------------------------------------------------------------------------
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Creates a single Virtual Directory (code taken from mkwebdir.vbs and
' changed for single vDir creation).
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub CreateVDir(vPath)
Dim vRoot,vDir,webSite
On Error Resume Next
' get the local host default web
set webSite = findWeb("localhost", "Default Web Site")
if IsObject(webSite)=False then
Display "Unable to locate the Default Web Site"
exit sub
else
'display webSite.name
end if
' get the root
set vRoot = webSite.GetObject("IIsWebVirtualDir", "Root")
If (Err <> 0) Then
Display "Unable to access root for " & webSite.ADsPath
Exit sub
else
'display vRoot.name
End IF
' delete existing web if needed
vRoot.Delete "IIsWebVirtualDir",vName
vRoot.SetInfo
Err=0 ' reset error
' create the new web
Set vDir = vRoot.Create("IIsWebVirtualDir",vName)
If (Err <> 0) Then
Display "Unable to create " & vRoot.ADsPath & "/" & vName & "."
exit sub
else
'display vdir.name
end if
' set properties on the new web
vDir.AccessRead = true
vDir.Path = vPath
vDir.Accessflags = 529
VDir.AppCreate False
If (Err <> 0) Then
Display "Unable to bind path " & vPath & " to " & vRoot.Name & "/" & vName & ". Path may be invalid."
exit sub
end If
' commit changes
vDir.SetInfo
If (Err <> 0) Then
Display "Unable to save changes for " & vRoot.Name & "/" & vName & "."
exit sub
end if
' report all ok
WScript.Echo Now & " " & vName & " virtual directory " & vRoot.Name & "/" & vname & " created successfully."
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Finds the specified web.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function findWeb(computer, webname)
On Error Resume Next
Dim websvc, site
dim webinfo
Dim aBinding, binding
set websvc = GetObject("IIS://"&computer&"/W3svc")
if (Err <> 0) then
exit function
end if
' First try to open the webname.
set site = websvc.GetObject("IIsWebServer", webname)
if (Err = 0) and (not isNull(site)) then
if (site.class = "IIsWebServer") then
' Here we found a site that is a web server.
set findWeb = site
exit function
end if
end if
err.clear
for each site in websvc
if site.class = "IIsWebServer" then
'
' First, check to see if the ServerComment
' matches
'
If site.ServerComment = webname Then
set findWeb = site
exit function
End If
aBinding=site.ServerBindings
if (IsArray(aBinding)) then
if aBinding(0) = "" then
binding = Null
else
binding = getBinding(aBinding(0))
end if
else
if aBinding = "" then
binding = Null
else
binding = getBinding(aBinding)
end if
end if
if IsArray(binding) then
if (binding(2) = webname) or (binding(0) = webname) then
set findWeb = site
exit function
End If
end if
end if
next
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Gets binding info.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
function getBinding(bindstr)
Dim one, 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)
end function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Displays error message.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Display(Msg)
WScript.Echo Now & ". Error Code: " & Hex(Err) & " - " & Msg
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Display progress/trace message.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Trace(Msg)
WScript.Echo Now & " : " & Msg
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Remove the web.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub DeleteWeb(WebServer, WebName)
' delete the exsiting web (ignore error if missing)
On Error Resume Next
Dim vDir
display "deleting " & WebName
WebServer.Delete "IISWebVirtualDir",WebName
WebServer.SetInfo
If Err=0 Then
DISPLAY "WEB " & WebName & " deleted."
else
display "can't find " & webname
End If
End Sub
'
' The .NET PetShop Blueprint Application WebSite Setup
'
' File: CreateWeb.vbs
' Date: November 10, 2001
'
' Creates a new vdir for this project. Set vName to name of folder on disk
' that holds the files.
'
'==============================================================================
'
' Copyright (C) 2001 Microsoft Corporation
'
'==============================================================================
Option Explicit
dim vPath
dim scriptPath
dim vName
vName="PetShop" ' name of web to create
' *****************************************************************************
'
' 1. Create the IIS Virtual Directory
'
' *****************************************************************************
' get current path to folder and add web name to it
scriptPath = left(Wscript.ScriptFullName,len(Wscript.ScriptFullName ) -len(Wscript.ScriptName))
vPath = scriptPath & "Web"
'call to create vDir
CreateVDir(vPath)
' ----------------------------------------------------------------------------
'
' Helper Functions
'
' -----------------------------------------------------------------------------
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Creates a single Virtual Directory (code taken from mkwebdir.vbs and
' changed for single vDir creation).
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub CreateVDir(vPath)
Dim vRoot,vDir,webSite
On Error Resume Next
' get the local host default web
set webSite = findWeb("localhost", "Default Web Site")
if IsObject(webSite)=False then
Display "Unable to locate the Default Web Site"
exit sub
else
'display webSite.name
end if
' get the root
set vRoot = webSite.GetObject("IIsWebVirtualDir", "Root")
If (Err <> 0) Then
Display "Unable to access root for " & webSite.ADsPath
Exit sub
else
'display vRoot.name
End IF
' delete existing web if needed
vRoot.Delete "IIsWebVirtualDir",vName
vRoot.SetInfo
Err=0 ' reset error
' create the new web
Set vDir = vRoot.Create("IIsWebVirtualDir",vName)
If (Err <> 0) Then
Display "Unable to create " & vRoot.ADsPath & "/" & vName & "."
exit sub
else
'display vdir.name
end if
' set properties on the new web
vDir.AccessRead = true
vDir.Path = vPath
vDir.Accessflags = 529
VDir.AppCreate False
If (Err <> 0) Then
Display "Unable to bind path " & vPath & " to " & vRoot.Name & "/" & vName & ". Path may be invalid."
exit sub
end If
' commit changes
vDir.SetInfo
If (Err <> 0) Then
Display "Unable to save changes for " & vRoot.Name & "/" & vName & "."
exit sub
end if
' report all ok
WScript.Echo Now & " " & vName & " virtual directory " & vRoot.Name & "/" & vname & " created successfully."
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Finds the specified web.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function findWeb(computer, webname)
On Error Resume Next
Dim websvc, site
dim webinfo
Dim aBinding, binding
set websvc = GetObject("IIS://"&computer&"/W3svc")
if (Err <> 0) then
exit function
end if
' First try to open the webname.
set site = websvc.GetObject("IIsWebServer", webname)
if (Err = 0) and (not isNull(site)) then
if (site.class = "IIsWebServer") then
' Here we found a site that is a web server.
set findWeb = site
exit function
end if
end if
err.clear
for each site in websvc
if site.class = "IIsWebServer" then
'
' First, check to see if the ServerComment
' matches
'
If site.ServerComment = webname Then
set findWeb = site
exit function
End If
aBinding=site.ServerBindings
if (IsArray(aBinding)) then
if aBinding(0) = "" then
binding = Null
else
binding = getBinding(aBinding(0))
end if
else
if aBinding = "" then
binding = Null
else
binding = getBinding(aBinding)
end if
end if
if IsArray(binding) then
if (binding(2) = webname) or (binding(0) = webname) then
set findWeb = site
exit function
End If
end if
end if
next
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Gets binding info.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
function getBinding(bindstr)
Dim one, 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)
end function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Displays error message.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Display(Msg)
WScript.Echo Now & ". Error Code: " & Hex(Err) & " - " & Msg
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Display progress/trace message.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Trace(Msg)
WScript.Echo Now & " : " & Msg
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Remove the web.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub DeleteWeb(WebServer, WebName)
' delete the exsiting web (ignore error if missing)
On Error Resume Next
Dim vDir
display "deleting " & WebName
WebServer.Delete "IISWebVirtualDir",WebName
WebServer.SetInfo
If Err=0 Then
DISPLAY "WEB " & WebName & " deleted."
else
display "can't find " & webname
End If
End Sub
兴国资源网 Design By www.nnzcdc.com
广告合作:本站广告合作请联系QQ:858582 申请时备注:广告合作(否则不回)
免责声明:本站资源来自互联网收集,仅供用于学习和交流,请遵循相关法律法规,本站一切资源不代表本站立场,如有侵权、后门、不妥请联系本站删除!
免责声明:本站资源来自互联网收集,仅供用于学习和交流,请遵循相关法律法规,本站一切资源不代表本站立场,如有侵权、后门、不妥请联系本站删除!
兴国资源网 Design By www.nnzcdc.com
暂无评论...
更新日志
2024年05月22日
2024年05月22日
- 《邓紫棋精选》[FLAC/分轨][980MB]
- 出发吧麦芬尤米尔深渊试炼怎么过 尤米尔深渊阵容打法攻略
- dnf属性lv转移是什么意思
- dnf属性成长用什么材料
- 《贪婪之秋2》登陆平台介绍
- 《机器节奏》成就达成条件一览
- 2024年04月13日
- TOGE-12083-84【TchaikovskySwanlake-AndrePrevin】2CD【ISO】
- SusieArioli,JordanOfficer-NightLights[SP1020](2014)[FLAC]
- 东野圭吾改编新片《彷徨之刃》豆瓣6.6:寡淡又平庸
- 游戏史的绝对经典 CDPR庆祝《巫师3》9周年纪念!
- 波音又出事!一架载468人大型客机的引擎突然起火
- 群星.1994-华纳IN爆榜3辑【华纳】【WAV+CUE】
- 古巨基.2008-GUITAR.FEVER(LPCD45)【金牌大风】【WAV+CUE】
- 自然卷.2005-大卷包小卷【风和日丽】【WAV+CUE】