'---------------------------------------------------
' The function is called by the RemoteActivateServer immediately after activating a specific project on the server.
' RemoteActivateServer is an activation server object that processes server requests.
' The function is executed on the accessories server that performs the activation.
' Parameters:
' ActivateDocument As SPSSMR.Management.Activate.ActivateDocument
' SiteName As String
' ClusterName As String
' ProjectName As String
Function OnAfterSiteActivateProject(ActivateDocument, SiteName, ClusterName, ProjectName, RequestStatus, TaskId)
Dim serverName, userName, userTicket
Dim logInstance

Set logInstance = CreateObject("AppLog.AppLog")
logInstance.Open( "ACS", 1, "")

On Error GoTo ErrorHandler
' Get login information from the ActivateDocument object
Dim site
for each site in ActivateDocument.ActivateSettings.Sites
serverName = site.DpmServerName
userName = site.UserName
userTicket = site.UserTicket
Exit For
next

' Login to the Accessory server
Dim agent
Set agent = CreateObject("SPSSMR.DPM.Security.Login.Agent2")
If (serverName <>"") Then
agent.ConnectToDPMServer(serverName)
End If

If (userName <>"") Then
agent.TicketLogin( userName, userTicket)
Else
agent.LoginAsTrustedWindowsAccount()
End If

' Get the web survey URL from the DPM properties
Dim projectProperties, projectMRInterviewProperties
Set projectProperties = agent.Server.Projects.Item(ProjectName).Properties.GetInterface("{82944014-CE5A-11D3-98B6-00C04F5637EB}")
Set projectMRInterviewProperties = projectProperties.Item ("mrInterview").Value.GetInterface("{82944014-CE5A-11D3-98B6-00C04F5637EB}")

Dim projectStatus
Set projectStatus = projectProperties.Item("Status").Value

Dim activeSurveyUrl, testSurveyUrl
Set activeSurveyUrl =""
Set testSurveyUrl =""
If (projectStatus = "Active" ) Then
activeSurveyUrl = projectMRInterviewProperties.Item("InterviewStartURL").Value
testSurveyUrl = activeSurveyUrl + "&i.test=1"
Else
If (projectStatus ="Test" ) Then
activeSurveyUrl = ""
testSurveyUrl = projectMRInterviewProperties.Item("InterviewStartURL").Value +"&i.test=1"
End If
End If

' Get the Email server and port from the DPM properties
Dim emailServer, emailPort
Set emailServer = ""
Set emailPort = 25
Set emailServer = agent.Server.Properties.Item("EmailServerName").Value
Set emailPort = agent.Server.Properties.Item("EmailServerPort").Value

If (emailServer = "NOT_SET" ) Then
Set emailServer = "smtp.my_company.com"
Set emailPort = 25
End if

' Send Email to the activation administrator
Dim NameSpace
Dim Email
NameSpace = "http://schemas.microsoft.com/cdo/configuration/"
Set Email = CreateObject("CDO.Message")
Email.From = "from_address@my_company.com"
Email.To = "to_address@my_company.com"

Dim htmlBody

If ( RequestStatus = 3 or RequestStatus=5 or RequestStatus = 6 ) Then
Email.Subject = "Project '" +ProjectName +"' has been activated"

htmlBody = "Project <"+"b"+">'"+ ProjectName + "'"+"<"+"/"+"b"+"> has been activated. "
If ( projectStatus = "Active") Then
htmlBody = htmlBody + "Participants wanting to take the 'live' survey should use this URL: " + "<" + "a" + " href" + "='" + activeSurveyUrl + "'" + ">" + activeSurveyUrl + "<" + "/" + "a" + ">"
htmlBody = htmlBody + "Designers wanting to test the survey should use this URL: " + "<" + "a" + " href" + "='" + testSurveyUrl + "'" + ">" + testSurveyUrl + "<" + "/" + "a" + ">"
Else
If (projectStatus = "Test" ) Then
htmlBody = htmlBody + "Designers wanting to test the survey should use this URL: " + "<" + "a" + " href" + "='" + testSurveyUrl + "'" + ">" + testSurveyUrl + "<" + "/" + "a" + ">"
End If
End If
Else
If ( RequestStatus = 4 ) Then
Email.Subject = "Activate project '" +ProjectName +"' failed."
htmlBody = "Activate project <"+"b"+">'"+ ProjectName + "'"+"<"+"/"+"b"+"> failed. "

Dim connectionString
Dim selectQuery
Dim recordSet
Dim connect

Dim dbServerName
Set dbServerName = agent.Server.Properties.Item("SessionDatabaseServer").Value

Dim fmRootLocal
Set fmRootLocal = agent.Server.Properties.Item("FileMgt_RootFolderLocalPath").Value

Set connectionString = "Provider=mrOleDB.Provider.2;Persist Security Info=False; User ID="""";Data Source=mrRdbDsc2;Location=""Provider=SQLOLEDB.1;Persist Security Info=False;Integrated Security=SSPI;Initial Catalog='mrInterviewData';Data Source="+ dbServerName +""";Extended Properties="""";Initial Catalog="+ fmRootLocal +"\Shared\Config\ServerActivationMessages.mdd; Mode=ReadWrite;MR Init MDSC="""";MR Init MDSC Access=2;MR Init MDM Version=""""; MR Init MDM Language="""";MR Init MDM Context="""";MR Init MDM Label Type="""";MR Init MDM Access=0;MR Init MDM DataSource Use=0;MR Init MDM Version Variable=False;MR Init Category Names=0;MR Init Category Values=0;MR Init Allow Dirty=False;MR Init Validation=True;MR Init Input Locale=0;MR Init Output Locale=0;MR Init Project=ServerActivationMessages;MR Init Custom="""";MR Init MDM Document="""";MR Init Overwrite=0;MR Init Native Schema=False;MR Init Merge Data Elements=False"
Set selectQuery = "select Respondent.Serial, EntryTime, Message from vdata where TaskID ='"+ TaskId +"' order by EntryTime"
Set connect = CreateObject("ADODB.Connection")
connect.Open( connectionString)

Set recordSet = CreateObject("ADODB.Recordset")
Set recordSet = connect.Execute( selectQuery)

Dim messageStrings
Set messageStrings = ""

Dim index
Set index = -1

Dim value1, value2, value3
while NOT recordSet.EOF
set index = index +1
Set value2 = recordSet.Fields[1].Value
Set value3 = recordSet.Fields[2].Value
Set messageStrings = messageStrings + CText( index ) + " "+ CTEXT(value2)+ " "+ CTEXT(value3) + mr.CrLf

recordSet.MoveNext()
End while

recordSet.close()
Set recordSet = null

connect.close()
Set connect = null

htmlBody = htmlBody + mr.CrLf + messageStrings
End If
End If

Email.HtmlBody = htmlBody

Dim objConfig
Set objConfig = CreateObject("CDO.Configuration")
Dim fields

Set fields = objConfig.Fields
fields[NameSpace+"sendusing"] = 2
fields[NameSpace+"smtpserver"] = emailServer
fields[NameSpace+"smtpserverport"] = emailPort
fields[NameSpace+"smtpauthenticate"] = 1
fields[NameSpace+"sendusername"] = ""
fields[NameSpace+"sendpassword"] = ""
fields.Update()

Set Email.Configuration = objConfig

Email.Send()

ErrorHandler:
' Log the error and exit
logInstance.Log("Error executing script after site activation completed (line " + CText(Err.LineNumber) + "): " + _
Err.Description + " (0x" + CText(Format(Err.Number, "X")) + ")", 4)
logInstance.Log("Unable to send email when activating project "+ ProjectName+" : "+ Err.Description, 4)
Exit Function
End Function