Internet Pratica/IPRAT_01.iso/ASP/SRC/phonemsg.asp

Text File | 2001-06-08 | 11.0 KB | 374 lines

<%
'*******************************************************
'*     ASP 101 Sample Code - http://www.asp101.com     *
'*                                                     *
'*   This code is made available as a service to our   *
'*      visitors and is provided strictly for the      *
'*               purpose of illustration.              *
'*                                                     *
'* Please direct all inquiries to [e-mail] *
'*******************************************************
%>

<%
' If this is from a form submission then we send a message.
' O/w we simply show the form for them to fill out.
If Request.Form("action") = "send" Then
    ' They've already seen and filled out the form.
    ' Start the message sending process...

    Dim strTo       ' Who the message is for
    Dim strTakenBy  ' Who answered the phone
    Dim strCaller   ' Who was calling
    Dim strSubject  ' Out email subject line
    Dim strBody     ' Our email message body
    Dim bMsgSent    ' Boolean indication success or failure

    ' Get the users involed
    strTo      = Request.Form("to")
    strTakenBy = Request.Form("takenby")
    strCaller  = Request.Form("caller")

    ' Build our subject line
    strSubject = "Phone Msg: " & strCaller

    ' Build our message body
    strBody = ""
    strBody = strBody & "You got a phone call." & vbCrLf & vbCrLf
    strBody = strBody & " From: "  & Request.Form("mrs") & " " & strCaller & vbCrLf
    strBody = strBody & "   Of: "  & Request.Form("company") & vbCrLf
    strBody = strBody & "   On: "  & Request.Form("date") & vbCrLf
    strBody = strBody & "   At: "  & Request.Form("time") & vbCrLf
    strBody = strBody & "Phone: "  & Request.Form("phone") & vbCrLf
    strBody = strBody & "Notes: "  & Request.Form("notes") & vbCrLf
    strBody = strBody & vbCrLf & "Message:" & vbCrLf
    strBody = strBody & Request.Form("message") & vbCrLf

    ' Send the message and store status sent back
    bMsgSent = SendEmail(strTakenBy, strTo, strSubject, strBody)

    ' Display either success or failure message
    If bMsgSent Then
        %>
        <p>
        <b>Your message has been sent to <%= Server.HTMLEncode(strTo) %>.</b>
        </p>
        <p>
        A preview of your message is below:
        </p>

        <p>
        <%= Replace(Server.HTMLEncode(strBody), vbCrLf, "<br />" & vbCrLf) %>
        </p>
        <%
    Else
        %>
        <p>
        There was a problem sending your message, please try
        again later or notify the recipient via another method.
        </p>
        <%
    End If
Else
    ' This means we're displaying the form so here goes...

    ' To make this interesting I'm getting a list of employees
    ' from a DB or text file so you don't have to keep typing
    ' the names into the form fields.

    ' The recordset is for the employee list.  I then build a
    ' set of options for use with any select box and store it
    ' in the string variable for multiple uses.  The last var
    ' is just a temp building area.
    Dim rstEmployeeList
    Dim strEmpOptions
    Dim strTemp

    ' Expected format for our recordset is: first, last, email
    ' Both the DB and Text File routines work and are listed
    ' below.  I was just going to do a text file, but I figured
    ' people would immediately want to hook this up to their
    ' employee DB so I added that capability as well.
    ' Modifying the DB function to work with your DB should
    ' be pretty straight forward.
    '
    ' Make sure only one of the lines below is un-commented
    ' or you'll be doing twice the work you need to!
    Set rstEmployeeList = GetCompanyListFromFile(Server.MapPath("phonemsg.txt"))
    'Set rstEmployeeList = GetCompanyListFromDB

    ' Start with first employee
    rstEmployeeList.MoveFirst

    ' Loop through the RS and build the option string.
    Do While Not rstEmployeeList.EOF
        strTemp = rstEmployeeList.Fields("first").Value & " " _
            & rstEmployeeList.Fields("last").Value & " " _
            & "<" & rstEmployeeList.Fields("email").Value & ">"

        strEmpOptions = strEmpOptions & "<option value=""" & strTemp & """>" _
            & strTemp & "</option>" & vbCrLf

        rstEmployeeList.MoveNext
    Loop

    ' Close and dispose of our RS
    rstEmployeeList.Close
    Set rstEmployeeList = Nothing

    ' Now we just build our form.
    ' The message for section was originally built from the same
    ' string as shown in the commented out section, but so you can
    ' play with it on our site, I thought I should open it up to
    ' let you enter any address.
    %>

    <form action="<%= Request.ServerVariables("URL") %>" method="post">
    <input type="hidden" name="action" value="send" />
    <table border="0" cellspacing="0" cellpadding="0"><tr><td>
    <table border="0" cellspacing="2" cellpadding="2">
        <tr>
            <td colspan="4" align="center">
                <font size="+2"><b>While You Were Out</b></font>
            </td>
        </tr>
        <tr>
            <td align="right">Message For:</td>
            <td colspan="3">
                <input type="text" name="to" value="Enter Email" size="30" />
                <!--
                <select name="to" />
                <%= strEmpOptions %>
                </select>
                -->
            </td>
        </tr>
        <tr>
            <td align="right">Taken By:</td>
            <td colspan="3">
                <select name="takenby" />
                <%= strEmpOptions %>
                </select>
            </td>
        </tr>
        <tr>
            <td align="right">Date:</td>
            <td><input type="text" name="date" value="<%= Date() %>" size="10" /></td>
            <td align="right">Time:</td>
            <td><input type="text" name="time" value="<%= Time() %>" size="10" /></td>
            </td>
        </tr>
        <tr>
            <td align="right">
                <select name="mrs">
                    <option>Mr.</option>
                    <option>Mrs.</option>
                    <option>Ms.</option>
                </select>
            </td>
            <td colspan="3"><input type="text" name="caller" size="30" /></td>
        </tr>
        <tr>
            <td align="right">Company:</td>
            <td colspan="3"><input type="text" name="company" size="30" /></td>
        </tr>
        <tr>
            <td align="right">Phone:</td>
            <td colspan="3"><input type="text" name="phone" size="30" /></td>
        </tr>
        <tr>
            <td>
            </td>
            <td colspan="3">
                <table border="0" cellspacing="1" cellpadding="0">
                <tr>
                    <td><input type="checkbox" name="notes" value="Returned Call" />Returned Call</input></td>
                    <td><input type="checkbox" name="notes" value="Please Call" />Please Call</input></td>
                </tr>
                <tr>
                    <td><input type="checkbox" name="notes" value="Will Call Again" />Will Call Again</input></td>
                    <td><input type="checkbox" name="notes" value="Urgent" />Urgent</input></td>
                </tr>
                </table>
            </td>
        </tr>
    </table>
    <table border="0" cellspacing="2" cellpadding="2">
        <tr>
            <td colspan="4">
                Message:<br />
                <textarea name="message" cols="40" rows="10" wrap="virtual"></textarea>
            </td>
        </tr>
        <tr>
            <td colspan="4" align="right">
                <input type="submit" value="Send Message" />
            </td>
        </tr>
    </table>
    </td></tr></table>
    </form>
    <%
End If

' Reads the employee list in from a file and
' returns a recordset containing the data.
Function GetCompanyListFromFile(strFileFullPath)
    Const ForReading = 1
    Const adVarChar = 200

    Const FieldDelimiter = "|"
    ' This won't work:
    'Const RecordDelimiter = vbCrLf
    ' So...
    Dim RecordDelimiter
    RecordDelimiter = vbCrLf
    ' Anyone know if this can be implemented as a Const?
    ' If so I'd love to see it... mailto:[e-mail]

    Dim objFSO, objFile
    Dim strFile
    Dim arrCompanyList
    Dim rstTemp
    Dim arrTemp
    Dim I

    ' Read in the entire file
    Set objFSO  = Server.CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.OpenTextFile(strFileFullPath, ForReading, False)
    strFile = objFile.ReadAll
    objFile.Close
    Set objFile = Nothing
    Set objFSO  = Nothing

    ' Deal with trailing delimiters
    Do While Right(strFile, Len(RecordDelimiter)) = RecordDelimiter
        strFile = Left(strFile, Len(strFile) - Len(RecordDelimiter))
    Loop

    ' Split each line into an array
    arrCompanyList = Split(strFile, RecordDelimiter)

    ' Set up our new RS
    Set rstTemp = Server.CreateObject("ADODB.Recordset")
    rstTemp.Fields.Append "first", adVarChar, 255
    rstTemp.Fields.Append "last", adVarChar, 255
    rstTemp.Fields.Append "email", adVarChar, 255

    ' Open it up
    rstTemp.Open

    ' Loop through the array adding entries to the RS
    For I = LBound(arrCompanyList) To UBound(arrCompanyList)
        arrTemp = Split(arrCompanyList(I), FieldDelimiter)

        rstTemp.AddNew
        rstTemp.Fields("first").Value = arrTemp(0)
        rstTemp.Fields("last").Value = arrTemp(1)
        rstTemp.Fields("email").Value = arrTemp(2)
        rstTemp.Update
    Next

    ' Set the RS as the functions return value
    Set GetCompanyListFromFile = rstTemp
End Function

' This is simply a skeleton for you to use since I knew
' I'd get questions about it if I didn't provide one.
Function GetCompanyListFromDB()
    Const adUseClient = 3
    Const adOpenStatic = 3
    Const adLockReadOnly = 1
    Const adCmdText = &H0001

    Dim cnnTemp, rstTemp

    ' Connect to our DB
    Set cnnTemp = Server.CreateObject("ADODB.Connection")
    cnnTemp.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" _
        & Server.MapPath("phonemsg.mdb") & "; User Id=admin; " _
        & "Password=;"

    ' Create a RS that we can disconnect
    Set rstTemp = Server.CreateObject("ADODB.Recordset")
    rstTemp.CursorLocation = adUseClient
    Set rstTemp.ActiveConnection = cnnTemp

    ' Get the data... this is where you could change the
    ' sort order if you wanted to.
    rstTemp.Open "SELECT first, last, email " _
        & "FROM tblPhoneList ORDER BY last;" _
        , , adOpenStatic, adLockReadOnly, adCmdText

    ' Diconnect
    Set rstTemp.ActiveConnection = Nothing

    ' Close and dispose of our connection
    cnnTemp.Close
    Set cnnTemp = Nothing

    ' Set the RS as the functions return value
    Set GetCompanyListFromDB = rstTemp
End Function

' Simply sends a basic email message
Function SendEmail(strFrom, strTo, strSubject, strBody)
    On Error Resume Next

    Dim objMessage
    Dim bSuccess

    ' Set default to success
    bSuccess = True

    ' Quick check for valid email addr
    If IsValidEmail(strTo) Then
        ' Note that I'm using the Win2000 CDO and not CDONTS!
        ' Could be either, but I figured I'd let you guys
        ' see the new syntax since I rarely use it.
        Set objMessage = Server.CreateObject("CDO.Message")
        objMessage.To       = strTo
        objMessage.From     = strFrom
        objMessage.Subject  = strSubject
        objMessage.TextBody = strBody
        objMessage.Send
        Set objMessage = Nothing
    Else
        ' If email is invalid abort w/ a failure code.
        bSuccess = False
    End If

    ' Check for errors
    If Err.number <> 0 Then
        bSuccess = False
    End If

    ' Set return status
    SendEmail = bSuccess
End Function

' A quick email syntax checker.  It's pretty lame
' but it's quick and easy and will catch people
' who enter nothing.  Note it's pretty darn lax
' because I allow this format:
'  User Name <[e-mail]>
Function IsValidEmail(strEmail)
    Dim bIsValid
    bIsValid = True

    If Len(strEmail) < 5 Then
        bIsValid = False
    Else
        If InStr(1, strEmail, "@", 1) < 2 Then
            bIsValid = False
        Else
            If InStrRev(strEmail, ".") < InStr(1, strEmail, "@", 1) + 2 Then
                bIsValid = False
            End If
        End If
    End If

    IsValidEmail = bIsValid
End Function
%>