Improve company productivity with a Business Account.Sign Up

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 496
  • Last Modified:

Using IIS API with ColdFusion

I have read on a recent posting that the IIS API can be controlled by simply using a cfhttp posting.  I can't seem to find the correct variables to post.  Does anyone know of a great resource for this type of information or can anyone help me in my situation.  I basically want to create a website on the fly.  I found the makesite command but still a bit lost.
0
clayo
Asked:
clayo
  • 2
1 Solution
 
meverestCommented:
Hi,

let's see a reference to the article or post that you refer to, then we can assist in developing the cfhttp structure.  This is a relatively straightforward way to access vb type scripts from inside coldfusion.

Cheers.
0
 
clayoAuthor Commented:
0
 
meverestCommented:
right, OK - so you don;t really even have a web based script to work with yet.

The code snips attached contains two files: functions.asp and create_website.asp

Copy the relevant code into those two files and put them on a web site somewhere with appropriate user rights (remember that the interactive web user must have appropriate rights to acheive what you want to do... i.e. create a web site! ;-)

once you have those scripts loaded and running, you can use cfhttp like this:

            <cfhttp method="post" url="http://WEB.SITE.WITH.SCRIPTS/create_website.asp" username="USER WITH APPROPRIATE RIGHTS" password="PASSWORD" >
            <cfhttpparam type="formfield" name="UserName" value="#websiteanonuser#">
            <cfhttpparam type="formfield" name="Password" value="#websiteanonpasswd#">
            <cfhttpparam type="formfield" name="SiteHostName" value="#hostname#.#domain#">
            <cfhttpparam type="formfield" name="svrPath" value="#webroot#">
            <cfhttpparam type="formfield" name="LogPath" value="#logpath#">
            <cfhttpparam type="formfield" name="ServerName" value="#webserver.webserverhostname#">
            <cfhttpparam type="formfield" name="SiteID" value="#newid#">
            <cfhttpparam type="formfield" name="TheIPAddress" value="#ipaddress#">
            <cfhttpparam type="formfield" name="ApplicationPool" value="#webapppoolname#">
            </cfhttp>
            <cfif not find("OK", cfhttp.FileContent)>
                  <cfthrow message="Web site Creation on server #webserver.servername# failed because: #cfhttp.FileContent#">
            </cfif>

that should be enough to get you started?

Cheers.

<!-- #INCLUDE FILE="functions.asp" -->
<% Response.Buffer = True %>
<%
Dim ArgCount, BuName, BuVersion, BuFlags, CompObj, VersionMsg
ArgCount = 0
BuName= "New Web Site - " & Request.Form("UserName")
BuVersion = &HFFFFFFFF   ' Use next available version number
BuFlags = 0   ' No special flags
  Set CompObj = GetObject("IIS://" & Request.Form("ServerName"))
  ' Call Backup method, with appropriate parameters
'  CompObj.Backup BuName, BuVersion, BuFlags
   ' Make pretty version string
'  If BuVersion = &HFFFFFFFF Then
'        VersionMsg = "next version"
'  Else
'        VersionMsg = "version " & BuVersion
'  End If

Set ArgCount = nothing
Set BuName = nothing
Set BuVersion = nothing
Set BuFlags = nothing
Set CompObj = nothing
Set VersionMsg = nothing

        UserName   = Request.Form("UserName")
        Password   = Request.Form("Password")
        DomainName = Request.Form("SiteHostName")
        SelGroup   = Request.Form("SelectGroup")
        ServerName = Request.Form("ServerName")
        svrPath    = Request.Form("svrPath")
        LogPath    = Request.Form("LogPath")
        TheIP 	   = Request.Form("TheIPAddress")
		NewSiteID  = Request.Form("SiteID")
		AppPoolName= Request.Form("ApplicationPool")

		Response.Write(ServerName)

        ' Add user account
'        If Not AddUserAccount( ServerName, UserName, Password, DomainName, SelGroup ) Then Response.end

        ' Create the physical site
'        If Not CreatePhysicalSite( UserName, DomainName ) Then Response.end

        ' Create new site - Get the next available site id
'        NewSiteID = GetNextSiteID( ServerName )
'        If Not IsNumeric( NewSiteID ) Then Response.end

        ' Create new site - create in IIS
'        SendStatus "Creating the new site ... "
'        ExcludeWWW = False
'        If LCase( Request.Form("www") ) <> "yes" Then ExcludeWWW = True
        If Not CreateNewWebSite( ServerName, NewSiteID, DomainName, UserName, Password, svrPath, LogPath, AppPoolName) Then 
			Response.Write("OUCH!")
			Response.end 
		End If

        'Set application settings
        If IISVer = 4 Then
        If Not EstablishAppSettings40( ServerName, DomainName, NewSiteID ) Then Response.End
        ElseIf IISVer = 5 Then
        If Not EstablishAppSettings50( ServerName, DomainName, NewSiteID ) Then Response.End
        ElseIf IISVer = 6 Then
        If Not EstablishAppSettings60( ServerName, DomainName, NewSiteID ) Then Response.End
        End If
		
		Response.Write("OK")		 
%>

=====================================================

here is 'functions.asp'

=====================================================


<%
    Function AddUserAccount(ServerName, UserName, Password, DomainName, SelGroup)

      On Error Resume Next

        ' This function will return true is there are
        ' no errors, otherwise it will return a false

        ' Assume the best
        AddUserAccount = True

        ' Get object for computer
        Set ComputerObj = GetObject("WinNT://" & ServerName)

        If Err.Number <> 0 Then
            HandleError "Functions.inc", "AddUserAccount1"
            AddUserAccount = False
            Exit Function
        End If

        ' Phase 2 - Create the New User.
        Set NewUser = ComputerObj.Create("User", UserName)
        NewUser.SetInfo

        If Err.Number <> 0 Then
            HandleError "Functions.inc", "AddUserAccount2"
            AddUserAccount = False
            Exit Function
        End If

        ' Phase 3 - Adding Properties to the User

        ' Set password
        NewUser.SetPassword(Password)

        ' Set user's full name
        NewUser.FullName = DomainName

        ' Set user's description
        NewUser.Description = DomainName

        ' Set Additional Account Properties
        Flags = NewUser.Get("UserFlags")
        NewUser.Put "UserFlags", Flags Or UF_PASSWD_CANT_CHANGE Or UF_DONT_EXPIRE_PASSWD
        NewUser.SetInfo

        If Err.Number <> 0 Then
            HandleError "Functions.inc", "AddUserAccount3"
            AddUserAccount = False
            Exit Function
        End If

        ' Set Group
        Set GroupObj = GetObject("WinNT://" & ServerName & "/" & SelGroup)
        GroupObj.Add( "WinNT://" & ServerName & "/" & UserName )

        If Err.Number <> 0 Then
            HandleError "Functions.inc", "AddUserAccount"
            AddUserAccount = False
            Exit Function
        End If

        Set GroupObj    = Nothing
        Set NewUser     = Nothing
        Set ComputerObj = Nothing

    End Function

'-------------------------------------------------------------------------

    Function CreatePhysicalSite(UserName, DomainName)

      On Error Resume Next

        ' This function will return true is there are
        ' no errors, otherwise it will return a false

        ' Assume the best
        CreatePhysicalSite = True

        'Creates the directory
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set fldr = fso.CreateFolder( PHYSICAL_SITE_LOCATION_ROOT & UserName )

        'Create the initial web page
        Set fsDefFile = fso.CreateTextFile( fldr & "\Default.htm", True )
        fsDefFile.WriteLine( "Welcome to the future home of www." & DomainName )

        If Err.Number <> 0 Then
            HandleError "Functions.inc", "CreatePhysicalSite"
            CreatePhysicalSite = False
            Exit Function
        End If

        Set fsDefFile = Nothing
        Set fldr      = Nothing
        Set fso       = Nothing

    End Function

'-------------------------------------------------------------------------

    Function GetNextSiteID(ServerName)

      On Error Resume Next ' We're trying to throw an exception in the for loop

        ' Assume the worst - this function should return a numeric value
        GetNextSiteID = "An error has occurred"

        Set objComp = GetObject("IIS://" & ServerName & "/W3SVC")

        If Err.Number <> 0 Then
            HandleError "Functions.inc", "GetNextSiteID"
            Exit Function
        End If

        ' This loop will loop through all of the ACTIVE sites on the
        ' server.  Inside the loop, we're going to check the validity
        ' of the site index AFTER the current index of the loop.  Doing
        ' this, one of two things will happen: If there is an unused index
        ' in the midst of the active indicies, we will find it and use it
        ' OR if all of the indicies are active sites, we will continue
        ' through all of the active sites and we'll end up checking the
        ' validity and using the next available index.

        LargestSiteID = 1
        For Each IdxItem in objComp
            If IsNumeric( IdxItem.Name ) Then

                Set objTemp = GetObject("IIS://" & ServerName & "/W3SVC/" & CStr( CLng( IdxItem.Name ) + 1 ) & "/ROOT" )
                ' The previous line will throw an exception if the next index is not being used by an active site
                If Err.Number = ERR_IIS_SITE_DOESNT_EXIST Then
                    NewSiteID = CLng( IdxItem.Name ) + 1
                    Err.Clear
                    Exit For
                End If

                ' Of all of the site indicies, get the largest one - just in case - we may need it in the next conditional
                If CLng( IdxItem.Name ) > LargestSiteID Then LargestSiteID = CLng( IdxItem.Name )

            End If
        Next

        ' If all of the indicies are being used on active sites
        If NewSiteID = 0 Then
            ' Use the next available one
            NewSiteID = LargestSiteID + 1
        End If

        GetNextSiteID = NewSiteID

        Set objTemp = Nothing
        Set objComp = Nothing

    End Function

'-------------------------------------------------------------------------
    Function CreateNewWebSite(ServerName, SiteID, DomainName, AnonUserName, AnonPassword, RootPath, LogPath, AppPoolName)

      On Error Resume Next

        ' This function will return true is there are
        ' no errors, otherwise it will return a false

        ' Assume the worst
        CreateNewWebSite = False

        Set objComp = GetObject("IIS://" & ServerName & "/W3SVC")
        Set objNew = ObjComp.Create("IIsWebServer", SiteID )
        objNew.ServerComment = DomainName
		objNew.LogFileDirectory = RootPath & "logs"
		objNew.DefaultDoc = "index.html,index.htm,default.asp,default.htm"
'		objNew.LogExtFileFlags = "LogExtFileDate | LogExtFileTime | LogExtFileClientIp | LogExtFileUserName | LogExtFileMethod | LogExtFileUriStem | LogExtFileUriQuery | LogExtFileHttpStatus | LogExtFileBytesSent | LogExtFileUserAgent | LogExtFileReferer | LogExtFileProtocolVersion"
        objNew.SetInfo

        If Err.Number <> 0 Then
            HandleError "Functions.inc", "CreateNewWebSiteA"
            Exit Function
        End If
        
        If len(TheIP) > 0 then
            IpAddy = TheIP
        else 
            IpAddy = null
        End If
        
        If Err.Number <> 0 Then
            HandleError "Functions.inc", "CreateNewWebSiteIPerror"
            Exit Function
        End If

        ' Since "www" will be requested most of the time
        Dim aryBindings()
        ReDim aryBindings(0)
        aryBindings(0)= IpAddy & ":80:" & DomainName

        objNew.ServerBindings = aryBindings
        objNew.SetInfo

        If Err.Number <> 0 Then
            HandleError "Functions.inc", "CreateNewWebSiteB"
            Exit Function
        End If

        Set objRoot = objNew.Create ("IIsWebVirtualDir", "Root")
        objRoot.Path = RootPath
        objRoot.SetInfo

        If Err.Number <> 0 Then
            HandleError "Functions.inc", "CreateNewWebSiteC"
            Exit Function
        End If

        ' Defaults are controlled by the master properties of the www service
'        If LCase( Request.Form("AllowAnon") ) <> "yes" Then 
		objRoot.AuthAnonymous = True
'        If LCase( Request.Form("Read") )      =  "yes" Then 
		objRoot.AccessRead    = True
'        If LCase( Request.Form("Write") )     =  "yes" Then objRoot.AccessWrite   = True
'        If LCase( Request.Form("Execute") )   =  "yes" Then objRoot.AccessExecute = True
'        If LCase( Request.Form("Script") )    =  "yes" Then 
		objRoot.AccessScript  = True
'        If LCase( Request.Form("DirBrowse") )    =  "yes" Then objRoot.EnableDirBrowsing= True
        
		If AnonUserName <> "" and AnonPassword <> "" Then
			objRoot.AnonymousUserName = AnonUserName
			objRoot.AnonymousUserPass = AnonPassword
		End If
		
		objRoot.AppRoot = "/LM/W3SVC/" & SiteID & "/Root"
		objRoot.AppFriendlyName = DomainName
		objRoot.AppIsolated = 2
		
		If AppPoolName <> "" Then
			objRoot.AppPoolId = AppPoolName
		End If

		objRoot.SetInfo

        If Err.Number <> 0 Then
            HandleError "Functions.inc", "CreateNewWebSiteD"
            Exit Function
        End If

        ' Start the site
        objNew.Start

        If Err.Number <> 0 Then
            HandleError "Functions.inc", "CreateNewWebSiteE"
            Exit Function
        End If

        Set objRoot = Nothing
        Set objNew  = Nothing
        Set objComp = Nothing

        CreateNewWebSite = True
    End Function

'-------------------------------------------------------------------------
' For IIS 6.0

   Function EstablishAppSettings60(ServerName, DomainName, SiteID)

     On Error Resume Next

        ' This function will return true is there are
        ' no errors, otherwise it will return a false

        ' Assume the best
        EstablishAppSettings60 = True

        SET appPools = GetObject("IIS://localhost/w3svc/AppPools")
		SET NewAppPool = appPools.Create("IIsApplicationPool", DomainName)

        If Err.Number <> 0 Then
            HandleError "Functions.inc", "EstablishAppSettings60a"
            EstablishAppSettings60 = False
            Exit Function
        End If

		NewAppPool.AppPoolRecycleRequests = true
		NewAppPool.PeriodicRestartRequests = 2000
		NewAppPool.AppPoolIdentityType = POOLED

		'Save new app pool in IIS  
		NewAppPool.SetInfo()

       If Err.Number <> 0 Then
            HandleError "Functions.inc", "EstablishAppSettings60b"
            EstablishAppSettings60 = False
            Exit Function
        End If

		Set thisappPool = GetObject("IIS://localhost/w3svc/AppPools/" & DomainName)
		Set App = GetObject("IIS://" & ServerName & "/w3svc/" & SiteID & "/ROOT")
        'App.AppRoot = Replace( NewAppPool.ADsPath, "IIS://" & ServerName, "/LM" )
        App.AppRoot = NewAppPool.ADsPath
        App.AppFriendlyName = DomainName
        'App.AppIsolated = ISOLATE_WEB_APPLICATION
        App.AppPoolId = DomainName
		App.SetInfo()
		
		If Err.Number <> 0 Then
            HandleError "Functions.inc", "EstablishAppSettings60c"
            EstablishAppSettings60 = False
            Exit Function
        End If

        App.AppCreate2 POOLED
        If Err.Number <> 0 Then
            HandleError "Functions.inc", "EstablishAppSettings60d"
            EstablishAppSettings60 = False
            Exit Function
        End If

    End Function

'-------------------------------------------------------------------------
' For IIS 5.0

   Function EstablishAppSettings50(ServerName, DomainName, SiteID)

     On Error Resume Next

        ' This function will return true is there are
        ' no errors, otherwise it will return a false

        ' Assume the best
        EstablishAppSettings50 = True

        Set NewApplication = GetObject( "IIS://" & ServerName & "/W3SVC/" & SiteID & "/ROOT" )

        If Err.Number <> 0 Then
            HandleError "Functions.inc", "EstablishAppSettings50a"
            EstablishAppSettings50 = False
            Exit Function
        End If

        NewApplication.AppRoot = Replace( NewApplication.ADsPath, "IIS://" & ServerName, "/LM" )
        NewApplication.AppFriendlyName = DomainName
        NewApplication.AppIsolated = ISOLATE_WEB_APPLICATION
        NewApplication.SetInfo

        If Err.Number <> 0 Then
            EstablishAppSettings50 = False
            Exit Function
        End If

        NewApplication.AppCreate2 IIS_SITE_IS_OUTPROC

        If Err.Number <> 0 Then
            HandleError "Functions.inc", "EstablishAppSettings50b"
            EstablishAppSettings50 = False
            Exit Function
        End If

    End Function

'-------------------------------------------------------------------------
' For IIS 4.0

    Function EstablishAppSettings40(ServerName, DomainName, SiteID)

      On Error Resume Next

        ' This function will return true is there are
        ' no errors, otherwise it will return a false

        ' Assume the best
        EstablishAppSettings40 = True

        Set NewApplication = GetObject( "IIS://" & ServerName & "/W3SVC/" & SiteID & "/ROOT" )

        If Err.Number <> 0 Then
            HandleError "Functions.inc", "EstablishAppSettings40A"
            EstablishAppSettings40 = False
            Exit Function
        End If

        NewApplication.AppRoot = Replace( NewApplication.ADsPath, "IIS://" & ServerName, "/LM" )
        NewApplication.AppFriendlyName = DomainName
        NewApplication.SetInfo
                       
        If Err.Number <> 0 Then
            HandleError "Functions.inc", "EstablishAppSettings40B"
            EstablishAppSettings40 = False
            Exit Function
        End If
       
        'NewApplication.AppCreate OUTPROC
        Dim bolOutProcessApplication 
        NewApplication.AppCreate bolOutProcessApplication
        If Err.Number <> 0 Then
            HandleError "Functions.inc", "EstablishAppSettings40C"
            EstablishAppSettings40 = False
            Exit Function
        End If

    End Function

'-------------------------------------------------------------------------

    Function SetupFrontPageExtensions(DomainName, UserName)

      On Error Resume Next

        ' This function will return true is there are
        ' no errors, otherwise it will return a false

        ' Assume the best
        SetupFrontPageExtensions = True

       	Set WshShell = Server.CreateObject("WScript.Shell")
       	strCmdLine = chr(34) & session("FRONTPAGE40_SVR_EXT_PATH") & chr(34) & " -o install -t msiis -p 80 -m " & DomainName & " -u " & UserName
      	WshShell.Run( strCmdLine )
          Response.Write strCmdLine

        If Err.Number <> 0 Then
            HandleError "Functions.inc", "SetupFrontPageExtensions"
            SetupFrontPageExtensions = False
            Exit Function
		End If
    End Function

'-------------------------------------------------------------------------

    Sub HandleError(FileName, FunctionName)

        Response.Write "<HTML><BODY>"   ' If this wasn't sent, sent it now...
        Response.Write "<H2>An error has occurred.</H2>"
        Response.Write "File name: " & FileName & "    Function name: " & FunctionName & "<br>"
        Response.Write Err.Description
        Response.Write "</BODY></HTML>"
        Response.End

    End Sub

'-------------------------------------------------------------------------

    Sub SendStatus(Msg, LineBreak)

        Response.Write Msg
        If LineBreak Then Response.Write( "<br>" )
        Response.Flush

    End Sub
%>

Open in new window

0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now