ASP 101 - Active Server Pages 101 - Web01
The Place ASP Developers Go!

Please visit our partners


Windows Technology Windows Technology
15 Seconds
4GuysFromRolla.com
ASP 101
ASP Wire
VB Forums
VB Wire
WinDrivers.com
internet.commerce internet.commerce
Partners & Affiliates














ASP 101 is an
internet.com site
ASP 101 is an internet.com site
IT
Developer
Internet News
Small Business
Personal Technology

Search internet.com
Advertise
Corporate Info
Newsletters
Tech Jobs
E-mail Offers

ASP 101 News Flash ASP 101 News Flash





ASP Source Code:
<%
' 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:john@asp101.com
	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 <username@domain.com>
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
%>

Back the the Sample Output

Back to the Sample Index


Home |  News |  Samples |  Articles |  Lessons |  Resources |  Forum |  Links |  Search |  Feedback

Internet.com
The Network for Technology Professionals

Search:

About Internet.com

Legal Notices, Licensing, Permissions, Privacy Policy.
Advertise | Newsletters | E-mail Offers