引用 Active ds Type Library
Public Sub Create()
Dim objIIS As Object 'ADSI IIS对象
Dim objVirtualDirectory As Object 'ADSI IIS 虚拟目录对象
Dim strACLCommand As String '设置ACLs的命令行串
Dim mboolAllowScriptsToRun As Boolean '是否允许脚本运行
Dim mstrLastError As String '错误号
Dim mstrApplicationOwner As String '本地机器名
Dim mstrVirtualDirectoryName '虚拟目录名
Dim mstrPhysicalDirectoryName '物理目录名
mboolAllowScriptsToRun = True
On Error GoTo errHandle
'判断IIS服务是否存在
On Error Resume Next
Set objIIS = GetObject("IIS://localhost/W3SVC/1/Root/" & mstrVirtualDirectoryName)
If Err.Number = 0 Then
mstrLastError = "这个应用名已经存在"
GoTo exitPoint
End If
Set objIIS = Nothing
On Error GoTo 0
'创建IIS服务
Set objIIS = GetObject("IIS://localhost/W3SVC/1/Root")
'这里可以加入判断,对应的物理目录是否存在
'如果不存在则创建 参见API
'If Not FolderExists(mstrPhysicalDirectoryName) Then
' CreateNestedFoldersByPath mstrPhysicalDirectoryName
'End If
Set objVirtualDirectory = objIIS.Create("IISWebVirtualDir", mstrVirtualDirectoryName)
objVirtualDirectory.AccessScript = IIf(mboolAllowScriptsToRun, "True", "False") 'bolScriptPermissions
objVirtualDirectory.Path = mstrPhysicalDirectoryName
objVirtualDirectory.SetInfo