Solved

Using IIS API with ColdFusion

Posted on 2010-08-31
3
460 Views
Last Modified: 2012-06-27
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
Comment
Question by:clayo
  • 2
3 Comments
 
LVL 37

Expert Comment

by:meverest
ID: 33574656
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
 

Author Comment

by:clayo
ID: 33575612
0
 
LVL 37

Accepted Solution

by:
meverest earned 500 total points
ID: 33576738
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

Featured Post

DevOps Toolchain Recommendations

Read this Gartner Research Note and discover how your IT organization can automate and optimize DevOps processes using a toolchain architecture.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

I spent nearly three days trying to figure out how incorporate OAuth in Coldfusion for the Eventful API. Hopefully, this article will allow Coldfusion Programmers to buzz through the API when they need to. Basically, what this script does is authori…
I made this because I wanted to get e-mail with a attached csv file so I'd would be able to import user input into a MS Excel template, but I also wanted to register/save all inputs from each day in a file on the server. 1st - It creates a temp C…
The purpose of this video is to demonstrate how to set up the WordPress backend so that each page automatically generates a Mailchimp signup form in the sidebar. This will be demonstrated using a Windows 8 PC. Tools Used are Photoshop, Awesome…
This Micro Tutorial hows how you can integrate  Mac OSX to a Windows Active Directory Domain. Apple has made it easy to allow users to bind their macs to a windows domain with relative ease. The following video show how to bind OSX Mavericks to …

911 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now