QuickerSite

The script below creates (and removes) websites under IIS 5, 6 and 7 (Windows 2000, 2003 and 2008 Servers). You'll need to run this under an Administrator account. Don't try this on a shared hosted account. And if it works under a shared hosting account, CHANGE HOSTING ASAP :)

Download the full script here.

You'll find 2 asp files in the zip:

1. default.asp - this file includes iisoject.asp (see below):

<% 'the example below creates a site in IIS. dim iisSite set iisSite=new cls_iisSite iisSite.sSiteName ="MyNewSite" 'what you see in IIS-sitelist iisSite.sHostHeader ="www.MyNewSite.com" 'host header - variant without "www" will be created automatically! iisSite.sPath ="c:\inetpub\wwwroot\MyNewSite" 'home directory for website iisSite.DefaultDoc ="default.asp" 'default document for website if iisSite.create then Response.Write "<p>Site created OK - Check your IIS</p>" else Response.Write "<p>Site NOT created - error occurred</p><p>Check the following issues:</p><ul><li>You IUSR needs FULL ADMINISTRATOR permissions on your server</li><li>The folder (sPath) must be 'creatable'.</li><li>This website already may already exist in your IIS!</li></ul>" end if set iisSite=nothing 'the example below removes a site in IIS (by its host-header). 'remove site 'set iisSite=new cls_iisSite 'iisSite.sHostHeader ="www.MyNewSite.com" 'iisSite.remove() 'set iisSite=nothing %>

2. iisobject.asp (the class that creates the websites)

<% '(c) Pieter Cooreman - www.pietercooreman.be 'do not remove this copyright notice 'this script creates websites under IIS 5,6 and 7. 'don't try this on any shared windows hosting plan. This works only on Windows Servers you manage yourself. 'this class is part of QuickerSite webCMS - check www.quickersite.com class cls_IIS Public IISOBJ Private siteRunner,siteObject,webobj Private p_allsites Private Sub Class_Initialize On Error Resume Next Set IISOBJ = getObject("IIS://127.0.0.1/W3SVC") set p_allsites=nothing On Error Goto 0 end sub Private sub Class_Terminate On Error Resume Next Set IISOBJ = nothing set p_allsites=nothing On Error Goto 0 end sub Public Function GetNewSiteNumber() on error resume next dim counter counter=1 while GetAllSites.exists(cstr(counter)) counter=counter+1 wend GetNewSiteNumber=counter on error goto 0 end function Public Function GetAllSites if p_allsites is nothing then set p_allsites=server.CreateObject ("scripting.dictionary") on error resume next siteRunner=1 For each siteObject in IISOBJ if (siteObject.Class = "IIsWebServer") then set webobj = GetObject("IIS://localhost/w3svc/" & siteObject.name) p_allsites.Add webobj.name,webobj set webobj=nothing end if next on error goto 0 end if set GetAllSites=p_allsites end function end class class cls_iisSite Public sHostHeader,sPath,sSiteName,sitePath,siteObject,otherbindings,DefaultDoc Private IISOBJ,siteRunner,CustomErrors,i,myIISOBJ,otherbindingsArr Private Sub Class_Initialize On Error Resume Next Set myIISOBJ = new cls_IIS set IISOBJ=myIISOBJ.IISOBJ DefaultDoc="default.asp" On Error Goto 0 end sub Private Sub Class_Terminate On Error Resume Next Set myIISOBJ = nothing set IISOBJ=nothing On Error Goto 0 end sub Public function bHostnameExists otherbindingsArr=split(otherbindings,vbcrlf) bHostnameExists=false if trim(sHostHeader)="" then bHostnameExists=true exit function end if dim GetAllSites set GetAllSites=myIISOBJ.GetAllSites for each siteObject in GetAllSites dim fg fg=GetAllSites(siteObject).ServerBindings for i=lbound(fg) to ubound(fg) if instr(fg(i),sHostHeader)<>0 then bHostnameExists=true exit function end if dim j next next set GetAllSites=nothing end function Public function CreateFolder() CreateFolder=false dim fso set fso=server.CreateObject ("scripting.filesystemobject") if not fso.FolderExists (sPath) then fso.CreateFolder sPath end if set fso=nothing CreateFolder=true end function Public function Create() on error resume next Create=true if bHostnameExists then create=false exit function end if if not CreateFolder then create=false exit function end if if err.number <>0 then create=false exit function end if 'create new site dim newSite,newNumber newNumber=myIISOBJ.GetNewSiteNumber set newSite = IISOBJ.Create("IIsWebServer",newNumber) newSite.ServerComment = sSiteName newSite.DefaultDoc = DefaultDoc dim sbs(1),ij if instr(sHostHeader,"www.")<>0 then sbs(0)=":80:" & sHostHeader sbs(1)=":80:" & replace(sHostHeader,"www.","",1,-1,1) else sbs(0)=":80:" & sHostHeader sbs(1)=":80:" & "www." & sHostHeader end if newSite.ServerBindings=sbs newSite.SetInfo() 'set path set sitePath = newSite.Create("IIsWebVirtualDir", "ROOT") sitePath.Path = sPath sitePath.AccessRead = True sitePath.AccessScript= True sitePath.AppCreate2(2) sitePath.AppFriendlyName = "Default Application" sitePath.DontLog=true sitePath.AuthFlags = 5 sitePath.EnableDefaultDoc = True sitePath.DirBrowseFlags = &H4000003E sitePath.AccessFlags = 513 sitePath.SetInfo() newSite.Start() set sitePath=nothing set newSite=nothing on Error goto 0 end function public function remove remove=false if trim(sHostHeader)="" then exit function end if dim GetAllSites set GetAllSites=myIISOBJ.GetAllSites for each siteObject in GetAllSites dim fg fg=GetAllSites(siteObject).ServerBindings for i=lbound(fg) to ubound(fg) if instr(fg(i),sHostHeader)<>0 then on error resume next dim websiteParent Set websiteParent = GetObject(GetAllSites(siteObject).Parent) websiteParent.Delete GetAllSites(siteObject).Class, GetAllSites(siteObject).Name set websiteParent=nothing if err.number=0 then remove=true end if on error goto 0 exit function end if next next set GetAllSites=nothing end function end class %>

Jeodacksnanna says (25/02/2010 11:36:16):

you have a wonderful site!

maarten says (13/01/2010 19:19:30):

Excellent script Pieter, I tried it and it worked flawlessly! Keep it up!!

---

Leave a reply:

Your name:*
Your email:
Your message:*
Are you human?
	(*) Mandatory field