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 FunctionPrivate Sub Command2_Click() Call WebVirtualDir("aa", "aa", "E:\", "Default.asp") End Sub
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 FunctionPrivate Sub Command2_Click()
Call WebVirtualDir("aa", "aa", "E:\", "Default.asp")
End Sub