Solved

Using IIS API with ColdFusion

Posted on 2010-08-31
3
458 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

6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

Join & Write a Comment

The technique is by far very Simple! How we can export the ColdFusion query results to DOC file?  Well before writing this I researched a lot in Internet but did not found a good Answer anyways!  So i thought now i should share my small snippet w…
CFGRID Custom Functionality Series -  Part 1 Hi Guys, I was once asked how it is possible to to add a hyperlink in the cfgrid and open the window to show the data. Now this is quite simple, I have to use the EXT JS library for this and I achiev…
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…
Internet Business Fax to Email Made Easy - With eFax Corporate (http://www.enterprise.efax.com), you'll receive a dedicated online fax number, which is used the same way as a typical analog fax number. You'll receive secure faxes in your email, fr…

757 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

19 Experts available now in Live!

Get 1:1 Help Now