<%
Function GetEmailRows(nClientID, nLangID, nTotalCount)
GetEmailRows = ""
Dim strRows
Dim oConn
Dim rst
Dim nCount
nCount = 0 'start off with one and display only available
Set oConn = Server.CreateObject("ADODB.Connection")
oConn.Open strConn
strSQL = "SELECT * FROM ClientEmails WHERE (ClientID = " & nClientID & " AND LangID = " & nLangID & ") ORDER BY EmailNum"
Set rst = oConn.Execute(strSQL)
strRows = ""
Dim nEmailArray
Redim nEmailArray(nTotalCount, 9)
For i = 0 to nTotalCount-1
nEmailArray(i, 0) = -1 'EmailNum
nEmailArray(i, 1) = "" 'EmailDateType
nEmailArray(i, 2) = "" 'EmailDaysInd
nEmailArray(i, 3) = "" 'EmailBaseDate
nEmailArray(i, 4) = "" 'EmailDays
nEmailArray(i, 5) = "" 'EmailReplyTo
nEmailArray(i, 6) = "" 'EmailSubject
nEmailArray(i, 7) = "" 'EmailBody
nEmailArray(i, 8) = "" 'Error
Next
While ( Not rst.BOF And Not rst.EOF )
nEmailArray(nCount, 0) = rst.Fields("EmailNum").Value
nEmailArray(nCount, 1) = Trim(rst.Fields("EmailDateType").Value)
nEmailArray(nCount, 2) = Trim(rst.Fields("EmailDaysInd").Value)
str = rst.Fields("EmailBaseDate").Value
If str = 0 Then str = ""
nEmailArray(nCount, 3) = str
nEmailArray(nCount, 4) = rst.Fields("EmailDays").Value
nEmailArray(nCount, 5) = Trim(rst.Fields("EmailReplyAddr").Value)
nEmailArray(nCount, 6) = Trim(rst.Fields("EmailSubject").Value)
nEmailArray(nCount, 7) = Trim(rst.Fields("EmailBody").Value)
nEmailArray(nCount, 8) = ""
rst.MoveNext
nCount = nCount + 1
Wend
For nCount = 0 To nTotalCount-1
If nEmailArray(nCount, 0) <> "-1" Then
strRows = strRows & GetEmailRowBlock(nCount+1, nEmailArray(nCount, 1), nEmailArray(nCount, 2), nEmailArray(nCount, 3), nEmailArray(nCount, 4), nEmailArray(nCount, 5), nEmailArray(nCount, 6), nEmailArray(nCount, 7), nEmailArray(nCount, 8))
Else
strRows = strRows & GetEmailRowBlock(nCount+1, "", "", "", "", "", "", "", "")
End If
Next
rst.Close
oConn.Close
Set oConn = Nothing
GetEmailRows = strRows
End Function
Function GetEmailCount(nClientID)
GetEmailCount = 0
Dim oConn
Dim rst
Set oConn = Server.CreateObject("ADODB.Connection")
oConn.Open strConn
strSQL = "SELECT ClientEmails FROM Clients WHERE (ClientID = " & nClientID & ")"
Set rst = oConn.Execute(strSQL)
If Not rst.EOF And Not rst.BOF Then
If Not IsNull(rst.Fields(0).Value) Then
GetEmailCount = rst.Fields(0).Value
End If
End If
rst.Close
oConn.Close
Set oConn = Nothing
End Function
Function ProcessClientEmail(nClientID, nLangID, nEmail, strBaseType, strDaysInd, strBaseDate, strEmailDays, strReplyTo, strSubject, strBody)
Dim oConn
Set oConn = Server.CreateObject("ADODB.Connection")
oConn.Open strConn
Set cmd = Server.CreateObject("ADODB.Command")
cmd.ActiveConnection = oConn
cmd.CommandText = "ProcessClientEmail"
cmd.CommandType = 4 'Stored Procedure
cmd.Parameters.Refresh
'
'Calculate Email SendDate
'For 'A' it is BaseDate + EmailDays
'For 'B' it is BaseDate - EmailDays
'
Dim dtmBase
Dim dtmSend
Dim nDays
If strBaseType = "2" Then
dtmBase = CDate(strBaseDate)
nDays = CInt(strEmailDays)
If nDays > 0 Then
If strDaysInd = "A" Then
dtmSend = DateAdd("d", nDays, dtmBase)
Else
dtmSend = DateAdd("d", -nDays, dtmBase)
End If
Else
dtmSend = dtmBase
strDaysInd = "O"
End If
Else
dtmSend = 0 'EmailDateType may be 1
strBaseDate = ""
strDaysInd = "O"
End If
If strBaseDate = "" Then
dtmBase = 0
Else
dtmBase = CDate(strBaseDate)
End If
'Set the parameter values and try to get the unique ID
cmd.Parameters("@clientid") = nClientID
cmd.Parameters("@langid") = nLangID
cmd.Parameters("@emailnum") = nEmail
cmd.Parameters("@emaildatetype") = strBaseType
cmd.Parameters("@emaildaysind") = strDaysInd
cmd.Parameters("@emailbasedate") = dtmBase
cmd.Parameters("@emaildays") = strEmailDays
cmd.Parameters("@emailreplyaddr") = strReplyTo
cmd.Parameters("@emailsubject") = strSubject
cmd.Parameters("@emailbody") = strBody
cmd.Parameters("@emailsenddate") = dtmSend
cmd.Execute
oConn.Close
Set oConn = Nothing
End Function
Function GetEmailTypeScript(strTypeVal)
strData = ""
If(strTypeVal = "1" Or strTypeVal = "") then
strData = strData & ""
Else
strData = strData & ""
End If
If(strTypeVal = "2") then
strData = strData & ""
Else
strData = strData & ""
End If
GetEmailTypeScript = strData
End Function
Function GetEmailDaysIndScript(strTypeVal)
strData = ""
If(strTypeVal = "") then
strData = strData & ""
Else
strData = strData & ""
End If
If(strTypeVal = "A") then
strData = strData & ""
Else
strData = strData & ""
End If
If(strTypeVal = "B") then
strData = strData & ""
Else
strData = strData & ""
End If
If(strTypeVal = "O") then
strData = strData & ""
Else
strData = strData & ""
End If
GetEmailDaysIndScript = strData
End Function
Function GetEmailRowBlock(strNum, strTypeVal, strDaysIndVal, strBaseDateVal, strEmailDaysVal, strReplyToVal, strSubjectVal, strBodyVal, strError)
GetEmailRowBlock = ""
Dim strScript
' variables used for the actual controls
strType = "EmailType" & strNum
strDaysInd = "EmailDaysInd" & strNum
strBaseDate = "EmailBaseDate" & strNum
strEmailDays = "EmailDays" & strNum
strReplyTo = "ReplyTo" & strNum
strSubject = "Subject" & strNum
strEmailBody = "EmailBody" & strNum
' Put a default value of 0, if there is nothing in this field
If strEmailDaysVal = "" Then
strEmailDaysVal = "0"
End If
' Just display the email number starting from 3
If IsNumeric(strNum) Then
nEmail = CInt(strNum)+2
Else
nEmail = 1
End If
strScript = "
"
'
' Heading Table
'
strScript = strScript & "
" & vbCRLF
strScript = strScript & "
" & vbCRLF
strScript = strScript & "
" & vbCRLF
strScript = strScript & "Enter information for email number " & nEmail & "" & vbCRLF
strScript = strScript & "
" & vbCRLF
strScript = strScript & "
" & vbCRLF
strScript = strScript & "
" & vbCRLF
'
' If we have error then we fill this table
'
If strError <> "" Then
strScript = strScript & "
"
GetEmailRowBlock = strScript
End Function
Function Validate(nIndex)
Validate = ""
Dim strError
strEmailType = Request.Form("EmailType" & nIndex)
strDaysInd = Request.Form("EmailDaysInd" & nIndex)
strBaseDate = Request.Form("EmailBaseDate" & nIndex)
strEmailDays = Request.Form("EmailDays" & nIndex)
strReplyTo = Request.Form("ReplyTo" & nIndex)
strSubject = Request.Form("Subject" & nIndex)
strEmailBody = Request.Form("EmailBody" & nIndex)
' Email Type is required
If strEmailType = "" Then
strError = "Type is required "
End If
If strEmailType = "2" Then
' Email Base Date is required for 2
If strBaseDate = "" Then
strError = strError & "Base Date is required "
Else
If Not IsDate(strBaseDate) Or strBaseDate = "0" Then
strError = strError & "Base Date is invalid "
Else
dtmBase = CDate(strBaseDate)
If strEmailDays <> "" Then
If IsNumeric(strEmailDays) Then
nDays = CInt(strEmailDays)
If nDays >= 0 Then
If strDaysInd = "A" Then
dtmSend = DateAdd("d", nDays, dtmBase)
Else
dtmSend = DateAdd("d", -nDays, dtmBase)
End If
If dtmSend < Date Then
strError = strError & "Send date cannot be before today "
End If
End If
End If
End If
End If
End If
' Email Days Indicator is required for 2
If strDaysInd = "" Then
strError = strError & "Days Indicator is required "
End If
End If
' Email days is required always
If strEmailDays = "" Then
strError = strError & "Email Days is required "
Else
If IsNumeric(strEmailDays) Then
nDays = CInt(strEmailDays)
If nDays < 0 Then
strError = strError & "Email Days cannot be less than zero "
End If
Else
strError = strError & "Email Days must be a valid positive number "
End If
End If
' Reply Address is required always
If strReplyTo = "" Then
strError = strError & "Reply To is required "
Else
If Not IsValidEmailAddress(strReplyTo) Then
strError = strError & "Reply To must be a valid email address "
End If
End If
' Email Subject is required always
If strSubject = "" Then
strError = strError & "Subject is required "
End If
' Email Subject is required always
If strEmailBody = "" Then
strError = strError & "Body is required "
Else
iMaxLen = 500
iLen = Cint(Len(Trim(strEmailBody)))
If iLen > iMaxLen Then
iLen = iLen - iMaxLen
strError = strError & "Body - Length exceeds maximum of " & iMaxLen & " By " & iLen
End If
End If
Validate = strError
End Function
Function GetEmailFormRows(nClientID, nLangID, iQCnt, sErrInd)
GetEmailFormRows = ""
Dim strRows
Dim strErrFnd
strRows = ""
Dim strError
strError = ""
sErrInd = "N"
If iQCnt > 0 Then
For i = 1 to iQCnt
strEmailType = Request.Form("EmailType" & i)
strDaysInd = Request.Form("EmailDaysInd" & i)
strBaseDate = Request.Form("EmailBaseDate" & i)
strEmailDays = Request.Form("EmailDays" & i)
strReplyTo = Request.Form("ReplyTo" & i)
strSubject = Request.Form("Subject" & i)
strEmailBody = Request.Form("EmailBody" & i)
strError = Validate(i)
If strError = "" Then
ProcessClientEmail nClientID, nLangID, i, strEmailType, strDaysInd, strBaseDate, strEmailDays, strReplyTo, strSubject, strEmailBody
Else
sErrInd = "Y"
End If
strRows = strRows & GetEmailRowBlock(i, strEmailType, strDaysInd, strBaseDate, strEmailDays, strReplyTo, strSubject, strEmailBody, strError)
Next
End If
'
' If we did not get any errors, then send emails to clients
'
If strError = "" Then
strError = SendClientEmailEmails(strConn, nLangID, Session("ClientName"))
End If
GetEmailFormRows = strRows
End Function
Function IsValidEmailAddress(strEmailAddr)
bValid = True
If strEmailAddr = "" Then
bValid = False
End If
If bValid Then
'Check to see if it has a @ and a .
nPosAt = InStr(strEmailAddr, "@")
nPosDot = InStr(strEmailAddr, ".")
nLen = Len(strEmailAddr)
If nPosAt < 2 Or nPosDot < 4 Or nPosAt >= nLen-2 Or nPosDot >= nLen Then
bValid = False
End If
End If
IsValidEmailAddress = bValid
End Function
%>