' emailPassReferral.vbs
'
' Dennis Kelly <dennis.kelly@stevenspass.com>
' Copyright (C) 1999 Dennis Kelly
'
' This program is free software; you can redistribute it and/or
' modify it under the terms of the GNU General Public License
' as published by the Free Software Foundation; either version 2
' of the License, or (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU General Public License for more details.

' You should have received a copy of the GNU General Public License
' along with this program; if not, write to the Free Software
' Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

Const ForReading = 1, ForWriting = 2, ForAppending = 8

' Database settings
Const dbHost = "sql"
Const dbName = "Your Resort DB"
Const dbUser = "user"
Const dbPass = "password"
Dim dbConnectString
dbConnectString = "Provider=SQLOLEDB.1" _
    & ";Data Source=" & dbHost _
    & ";Initial Catalog=" & dbName _
    & ";User ID=" & dbUser _
    & ";Password=" & dbPass

' Database connection
Dim conn, rs
Set conn = CreateObject("ADODB.Connection")
conn.Open = dbConnectString
Set rs = CreateObject("ADODB.RecordSet")

' Mail Settings
Const smtpServer = "mail"
Const fromAddress = "support@myresort.com"
Const msgSubject = "Referral Code"
Const msgTemplateFile = "emailPassReferralTemplate.html"

' Read email template
Dim fso, f
Dim msgTemplateText
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile(msgTemplateFile, ForReading)
msgTemplateText = f.ReadAll
f.close
Set f = Nothing
Set fso = Nothing
    
Dim sqlText
sqlText = "SELECT prd.IPCode, prd.DiscountCode, ep.EmailAddress, pp.FirstName " _
    & "FROM PassReferralDiscount prd " _
    & "JOIN RTPOne.dbo.PersonProfile pp (NOLOCK) " _
    & "    ON pp.IPCode = prd.IPCode " _
    & "        AND pp.ProfileTypeCode = 1 " _  
    & "        AND pp.StatusCode = 1 " _
    & "JOIN RTPOne.dbo.EmailProfile ep (NOLOCK) " _
    & "    ON ep.IPCode = prd.IPCode " _
    & "        AND ep.ProfileTypeCode = 1 " _
    & "        AND ep.StatusCode = 1 " _
    & "WHERE prd.EmailedInd = 'false'" _

rs.Open = conn.Execute(sqlText)
Do While Not rs.EOF
    Set msg = CreateObject("CDO.Message")
    msg.From = fromAddress
    msg.To = rs("EmailAddress")
    msg.Subject = msgSubject
    msg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    msg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = smtpServer
    msg.Configuration.Fields.Update()

    Dim msgText
    msgText = msgTemplateText
    msgText = SetAttribute(msgText, "[$First Name$]", rs("FirstName"))
    msgText = SetAttribute(msgText, "[$Promo Code$]", rs("DiscountCode"))
    msg.HTMLBody = msgText
    
    On Error Resume Next
    msg.Send
    
    If Err.number = 0 Then
        sqlText = "UPDATE PassReferralDiscount " _
            & "SET EmailedInd = 'true', " _
            & "    UpdateDate = GETDATE() " _
            & "WHERE IPCode = " & rs("IPCode") & " " _
            & "    AND DiscountCode = '" & rs("DiscountCode") & "'"
        conn.Execute(sqlText)
    Else 
        WScript.Echo "Problem sending to IP Code: " & rs("IPCode")
    End If

    rs.MoveNext
Loop
rs.Close
conn.Close

' Name:    SetAttribute
' Purpose: Set the value of an attribute in a text template
' Receive: Text Template, Attribute, and Value
' Return:  Text
Function SetAttribute(str, attr, val)
    SetAttribute = Replace(str, attr, val, 1, -1, 1)
End Function