| 创建站点虚拟目录01 |
| 作者：佚名 来源：不详 整理日期：2007-4-13 |
参数：
strWebSite 虚拟站点名称
strFriendlyName 程序名称
strWebPath 网页文件路径
strDefaultDoc 默认网站首页
Public Function WebVirtualDir(ByVal strWebSite As String, ByVal strFriendlyName As String, ByVal strWebPath As String, ByVal strDefaultDoc As String) As Boolean
Dim objADSI As Object
Dim objWebVDir As Object
On Error GoTo Lib_Err
Set objADSI = GetObject("IIS://LocalHost/W3SVC/1/Root")
Set objWebVDir = objADSI.Create("IIsWebVirtualDir", strWebSite)
objWebVDir.SetInfo
Set objWebVDir = objADSI.GetObject("IIsWebVirtualDir", strWebSite)
objWebVDir.AppCreate True
objWebVDir.Put "AppFriendlyName", strFriendlyName
objWebVDir.Put "AppRoot", "/LM/W3SVC/1/Root/" & strWebSite
objWebVDir.Put "Path", strWebPath
objWebVDir.Put "AppIsolated", 0
objWebVDir.Put "DefaultDoc", strDefaultDoc
objWebVDir.Put "AccessFlags", 535
objWebVDir.SetInfo
WebVirtualDir = True
Lib_End:
Set objWebVDir = Nothing
Set objADSI = Nothing
Exit Function
Lib_Err:
WebVirtualDir = False
strError = Err.Description
Err.Clear
Resume Lib_End
End Function
=======================================
删除站点：
Function DeleteWebsite(ByVal IISPath As String) As Boolean
Dim DirObj
Dim ObjectParam As String
On Error GoTo errs
IISpath格式为：IIS://机器名/W3SVC/虚拟站点号/ROOT/虚拟目录
If IISPath = "" Then Exit Function
DeleteWebsite = True
ObjectParam = SplitParam(IISPath)
If UCase(ObjectParam) = "ROOT" Then ObjectParam = SplitParam(IISPath) 如果是虚拟站点，那么IIS路径应该再退到上一层
Set DirObj = GetObject(IISPath)
DirObj.Delete "IIsObject", ObjectParam
Exit Function
errs:
If err.Number <> 462 Then
MsgBox "您的系统上可能没有安装IIS或IIS已经破坏！" & Chr(13) & Chr(10) & _
"错误号【" & err.Description & "】", vbOKOnly + vbExclamation, "系统错误"
DeleteWebsite = False
End If
End Function
Function SplitParam(ObjectPath)
Note: Assume the string has been sanitized (no leading or trailing slashes)
On Error Resume Next
Dim SlashIndex
Dim TempParam
Dim ObjectPathLen
SplitParam = "" Assume no parameter
ObjectPathLen = Len(ObjectPath)
Separate the path of the node from the parameter
SlashIndex = InStrRev(ObjectPath, "/")
If (SlashIndex = 0) Or (SlashIndex = ObjectPathLen) Then
TempParam = ObjectPath
ObjectPath = "" ObjectParameter is more important
Else
TempParam = ObjectPath
ObjectPath = Left(ObjectPath, SlashIndex - 1)
TempParam = Right(TempParam, Len(TempParam) - SlashIndex)
End If
SplitParam = TempParam
End Function
使用方法：DeleteWebsite(IIspath) |
|
|
