Printable View
How can I create a virtual directory on the fly with either ASP or VB in IIS5? I can create a new folder and add my asp pages to it, but I need it to become a virtual directory with FrontPage extentions and seperate from any other virtual directories.
Something like this?
input.htm
create_virtual_iis_directory.aspCode:<html>
<head>
<title>Create new IIS virtual directories input page</title>
</head>
<body style="font-family:verdana">
<form method="post" action="create_virtual_iis_directory.asp" name="form1">
Enter Virtual Directory names and Physical paths seperated by a | if multiple inserts.<br>
i.e. virtual names : 'test1|test2' , physical : 'C:\dir1|C:\dir2'
<br>
<table border="1">
<tr><td>Virtual directory name :</td><td><input type="text" name="vdir"></td></tr>
<tr><td>Physical path :</td><td><input type="text" name="path"></td></tr>
<tr><td colspan="2"><input type="submit"> </td></tr>
</table>
</form>
</body>
</html>
Code:<%
Option Explicit
On Error Resume Next ' so error messages are displayed
Dim oParams, ParamNum
Dim ParamComputer, ParamWebSite, ParamVirtualDirs, ParamDirNames, ParamDirPaths, DirIndex
%>
<html>
<head>
<title>Create new IIS virtual directories input page</title>
</head>
<body style="font-family:verdana">
<%
ParamComputer = "LocalHost"
ParamWebSite = "DefaultWeb"
'PASS IN AN ARRAY FOR THE NEXT TWO PARAMS
ParamDirNames = split(request.form("vdir"),"|")
ParamDirPaths = split(request.form("path"),"|")
Call CreateVirtualWebDir(ParamComputer,ParamWebSite,ParamDirNames,ParamDirPaths)
'---------------------------------------------------------------------------------
Sub Display(Msg)
Response.Write Now & ". Error Code: " & Hex(Err) & " - " & Msg & "<br>"
End Sub
Sub Trace(Msg)
Response.Write Now & " : " & Msg & "<br>"
End Sub
Sub CreateVirtualWebDir(ComputerName,WebSiteName,DirNames,DirPaths)
Dim Computer, webSite, WebSiteID, vRoot, vDir, DirNum
On Error Resume Next
set webSite = findWeb(ComputerName, WebSiteName)
if IsObject(webSite) then
set vRoot = webSite.GetObject("IIsWebVirtualDir", "Root")
Trace "Accessing root for " & webSite.ADsPath
If (Err <> 0) Then
Display "Unable to access root for " & webSite.ADsPath
Else
DirNum = 0
If (IsArray(DirNames) = True) And (IsArray(DirPaths) = True) And (UBound(DirNames) = UBound(DirPaths)) Then
for DirNum = 0 to ubound(DirNames)
'Create the new virtual directory
Set vDir = vRoot.Create("IIsWebVirtualDir",DirNames(DirNum))
If (Err <> 0) Then
Display "Unable to create " & vRoot.ADsPath & "/" & DirNames(DirNum) &"."
Else
'Set the new virtual directory path
vDir.AccessRead = true
vDir.Path = CheckDirectory(DirPaths(DirNum))
If (Err <> 0) Then
Display "Unable to bind path " & DirPaths(DirNum) & " to " & vRoot.Name & "/" & DirNames(DirNum) & ". Path may be invalid."
Else
'Save the changes
vDir.SetInfo
If (Err <> 0) Then
Display "Unable to save configuration for " & vRoot.Name & "/" & DirNames(DirNum) &"."
Else
Trace "Web virtual directory " & vRoot.Name & "/" & DirNames(DirNum) & " created successfully."
End If
End If
End If
Err = 0
next
End If
End If
else
Display "Unable to find "& WebSiteName &" on "& ComputerName
End if
End Sub
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
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
Function CheckDirectory(fldr)
Dim fso,f
Set fso = CreateObject("Scripting.FileSystemObject")
If not fso.FolderExists(fldr) Then
set f = fso.CreateFolder(fldr)
End If
CheckDirectory = fldr
End Function
%>
</body>
</html>
---
Anglo Saxon
Perfect!! Thanks:D
Where did you find this code? It's not exactly something you write in 5 minutes.;)
Speak for yourself! ;)Quote:
Originally posted by Kings
Where did you find this code? It's not exactly something you write in 5 minutes.;)
This was in my code library. I had need of it for a project some time ago. The base code does actually come from MS I just re-wrote most of it to suit my needs and of course fixed all the bugs!! :D
Isnt this the norm for all coders? ;)
--
Anglo Saxon
But code libraries are usually for people with jobs :DQuote:
Originally posted by Anglo Saxon
Speak for yourself! ;)
This was in my code library. I had need of it for a project some time ago. The base code does actually come from MS I just re-wrote most of it to suit my needs and of course fixed all the bugs!! :D
Isnt this the norm for all coders? ;)
--
Anglo Saxon
the code looks just perfect but i'm looking for something more...i.e. i also want to delete the virtual directory if the need be through code only...one more thing that i did not understood is that how the code will behave if i've more than 1 websites running on my windows 2003 machine...any help is appreciated...