<%
Sub WriteStandardHeader (title)
%>
<% =title %>
<%
End Sub 'end Sub WriteStandardHeader
Sub WriteStandardFooter
%>
<%
End Sub
Sub WriteNoLinkHeader (title, sidebarmsg)
%>
<% =title %>
<% =sidebarmsg %>
<%
End Sub 'end Sub WriteNoLinkHeader
Sub WriteNoLinkFooter
%>
<%
End Sub
Function MyFormatTime (val)
'returns a string of the current time in h:mm AM/PM format
'note that when hour=12, it's noon which is 12:00 PM
If (val = "") Or IsNull(val) Or IsEmpty(val) Then
MyFormatTime = ""
Else
Dim h, m, suffix
h = hour(val)
If h >= 12 Then
If h <> 12 Then h=h-12
suffix="PM"
Else
suffix="AM"
End If
m = minute(val)
If m < 10 Then m="0" & m 'add the leading zero to assure two-digit minute value
MyFormatTime = h & ":" & m & " " & suffix
End If
End Function
Function MyFormatDate(val)
'returns dates of the format "May 2, 1980"
MyFormatDate = MonthName(Month(val)) & " " & Day(val) & ", " & Year(val)
End Function
Function GetLongNameOfABC(code)
Dim s
Select Case UCase(code)
Case "A"
s = "Attracting Supporters"
Case "B"
s = "Business Involvement"
Case "C"
s = "Congregational Participation"
Case "D"
s = "Direct Service"
Case "E"
s = "Elected Officials"
Case "F"
s = "Fundraising"
Case "G"
s = "Generating Media Coverage"
End Select
GetLongNameOfABC = s
End Function
Function GetClassificationString (RS)
Dim i, first, s, sqlt, RSt
first = 1
s=""
If Not IsNull(RS("EventTypeID")) And RS("EventTypeID")<>0 Then
sqlt="SELECT Description FROM tEventTypes WHERE EventTypeID=" & RS("EventTypeID")
Set RSt=conn.execute (sqlt)
If NOT RSt.EOF Then
s = RSt("Description")
If UCase(s) = "OTHER" Then s = RS("EventTypeOther")
If len(s) <> 0 Then first = 0 'protects against display of zero-length other entries
End If
RSt.Close
Set RSt= Nothing
End If
If RS("Policy Change") Then
If first=1 then first=0 Else s = s & ", "
s = s & "Policy Change"
End If
If RS("Awareness-Raising") Then
If first=1 then first=0 Else s = s & ", "
s = s & "Awareness-Raising"
End If
If RS("Direct Service") Then
If first=1 then first=0 Else s = s & ", "
s = s & "Direct Service"
End If
' For i=Asc("A") To Asc("G")
' If RS(chr(i))=-1 Then
' If first=1 Then first=0 Else s = s & ", "
' s = s & GetLongNameOfABC(chr(i))
' End If
' Next
' If RS("Meeting") Then
' If first=1 then first=0 Else s = s & ", "
' s = s & "Meeting"
' End If
' If RS("Training") Then
' If first=1 then first=0 Else s = s & ", "
' s = s & "Training"
' End If
GetClassificationString = s
End Function
Sub WriteOneActivity (RS, ongoingcount, ShowCATLinks, NameInBold)
Dim tmp, ActivityDesc
'begin common section
Response.Write "" & vbCrLf
If NOT IsNull(RS("Name")) Then
Response.Write "
"
tmp = "CAT"
End If
RSx.Close
Set RSx=Nothing
If tmp = "NOCAT" Then 'if we didn't already make a link to the CAT that's organizing the activity
sqlx = "SELECT [tLook-up reference].Event, tIndividuals.First, tIndividuals.Last, tIndividuals.Email, tIndividuals.Home, tIndividuals.Work, tIndividuals.HiddenID " & _
"FROM tIndividuals INNER JOIN [tLook-up reference] ON tIndividuals.HiddenID = [tLook-up reference].Individual " & _
"WHERE tIndividuals.[Primary Event Contact]=Yes AND tIndividuals.[Organizer for Stand 98]=Yes AND [tLook-Up Reference].Event=" & RS("HiddenID") & " ORDER by [tLook-up reference].[Date Entered];"
'note: sorting by date of association creation in order to display
'the first PEC associated in case there are multiple PECs
Set RSx = Connx.Execute (sqlx)
If NOT RSx.EOF Then 'if there is an associated individual
Response.Write "
Organized By:
"
Response.Write RSx("First") & " " & RSx("Last")
If NOT IsNull(RSx("Email")) Then Response.Write " (" & RSx("Email") & ")"
If NOT IsNull(RSx("Work")) Then
Response.Write " " & RSx("Work") & " (work)"
Else
If NOT IsNull(RSx("Home")) Then
Response.Write " " & RSx("Home") & " (home)"
End If
End If
Response.Write "
"
End If
RSx.Close
Set RSx=Nothing
End If
Connx.Close
Set Connx=Nothing
End If 'end CAT link section
'begin place section
tmp = ""
If Not IsNull(RS("Location Name")) Then tmp = tmp & RS("Location Name") & " "
If Not IsNull(RS("Location Address1")) Then tmp = tmp & RS("Location Address1") & " "
If Not IsNull(RS("Location Address2")) Then tmp = tmp & RS("Location Address2") & " "
If (Not IsNull(RS("City"))) OR (Not IsNull(RS("State"))) Then
tmp = tmp & RS("City") & ", " & RS("State") & " " & RS("Location Zip")
Else
If (Not IsNull(RS("Location City"))) OR (Not IsNull(RS("Location State"))) Then
tmp = tmp & RS("Location City") & ", " & RS("Location State") & " " & RS("Location Zip")
End If
End If
If tmp <> "" Then
Response.Write "
Place:
"
Response.Write tmp
Response.Write "
"
End If 'end place section
'begin classification section
tmp = GetClassificationString(RS)
If tmp <> "" Then
Response.Write "
Type Of Activity:
"
Response.Write tmp
Response.Write "
"
End If 'end classification section
If Not IsNull(RS("Public Figures Confirmed")) Then
Response.Write "
Public Figures:
" & RS("Public Figures Confirmed") & "
"
End If
If Not IsNull(RS("Other Organizations")) Then
Response.Write "
Other Organizers:
" & RS("Other Organizations") & "
"
End If
'begin description section that's different for activities and events
Select Case RS("ClassificationID")
Case 1
'begin event program section
ActivityDesc=RS("Event Program")
If (Not IsNull(ActivityDesc)) AND (Not IsEmpty(ActivityDesc)) Then
ActivityDesc = Replace(ActivityDesc, Chr(13), " ")
Response.Write "
Activity Program:
" & ActivityDesc & " "
End If
Response.Write vbCrLf & "
"
ActivityDesc = RS("Description")
If Not IsNull(ActivityDesc) AND Not IsEmpty(ActivityDesc) Then
ActivityDesc = Replace(ActivityDesc, Chr(13), "
") 'replace carraige returns with
's
Else
ActivityDesc = "Information not yet available"
End If
Response.Write ActivityDesc & " "
Case 2
Response.Write vbCrLf & "
"
ActivityDesc = RS("Description")
If NOT IsNull(ActivityDesc) Then
ActivityDesc = Replace(ActivityDesc, Chr(13), "
") 'replace carraige returns with
's
Response.Write ActivityDesc & " "
End If
End Select
Response.Write "
"
Response.Write "" & vbCrLf 'ends the A NAME anchor link from above
End Sub
Function Truncate (str, length)
If (Len(str) <= length) Or IsNull(str) Or IsEmpty(str) Then
Truncate = str
Else
Truncate = Left(str, length) & "..."
End If
End Function
Sub SendEmail(fromfield, tofield, subject, body)
Dim objMsg
Set objMsg = CreateObject("CDONTS.Newmail")
objMsg.From=fromfield
objMsg.To=tofield
objMsg.Subject=subject
objMsg.Body=body
objMsg.Send
Set objMsg = Nothing
End Sub
Function GetURLParametersOfReferer
'returns parameters, including the ? that precedes them, if any
'note that it returns parameters of the referring page
Dim pos, referer
referer = Request.ServerVariables("HTTP_REFERER")
pos = Instr(referer, "?")
If pos = 0 Then
GetURLParametersOfReferer = ""
Else
GetURLParametersOfReferer = Mid(referer, pos, Len(referer) - pos + 1)
End If
End Function
Function GetFieldValueSafe(paramRS, fld)
'only tries to retrieve from RS if not creating a new record and if there wasn't an error
If (Request("ActivityID") <> "New") AND (ErrorMode <> 1) Then
GetFieldValueSafe = paramRS.fields(fld).value
Else
GetFieldValueSafe = ""
End If
End Function
'common HTML macros
Sub WriteHeader (title, heading, sidebar)
WriteNoLinkheader title, sidebar
' Response.Write "" & title & ""
' Response.Write ""
If heading <> "" Then Response.Write "
" & heading & "
" & vbcrlf
End Sub
Sub WriteSectionHeader (heading)
Response.Write vbcrlf & "
" & heading & "
" & vbcrlf
End Sub
'common validation rules
Function IsValidPhoneNumber(ph)
'returns whether a phone number is validly formatted
'likes formats of the form ###-###-#### with an optional extension x#####
Dim extstartpos, good
good = IsNumeric(Left(ph, 3))
good = good AND IsNumeric(Mid(ph, 5, 3))
good = good AND IsNumeric(Mid(ph, 9, 4))
extstartpos=Instr(ph, " x") 'find start of extension section
If extstartpos<>0 Then
good = good AND IsNumeric(Mid(ph, extstartpos+2, Len(ph) - exstartpos - 1)) AND (len(ph) <= 19)
Else
good = good AND (len(ph)=12)
End If
IsValidPhoneNumber = good
End Function
Function IsValidWebPageAddress(addr)
'wants addresses with a fully-qualified domain name
'must have at least one letter after the dot and one before it too
Dim dotloc, httploc
dotloc = Instr(addr, ".")
' httploc = Instr(addr, "http://")
IsValidWebPageAddress = (dotloc <> 0) AND (dotloc <> 1) AND (dotloc <> Len(addr)) 'AND httploc = 0
End Function
Function IsValidEmailAddress(ph)
'checks for valid e-mail addresses
'requires presence of an @ sign and at least one dot in the domain name
'dot must follow behind at least one character after the @ sign -- 'user@.com' is invalid!
'also there must be at least one character after the . sign
Dim atloc, dotloc
atloc = instr(ph, "@")
dotloc = instrrev(ph, ".")
IsValidEmailAddress = (atloc <> 0) AND (dotloc <> 0) AND (atloc < dotloc - 1) AND (dotloc < len(ph))
End Function
'CATUpdate code shared by EventUpdate script
Function GetFieldValueSafe(paramRS, fld)
'only tries to retrieve from RS if not creating a new record and if there wasn't an error
If (Request("ActivityID") <> "New") AND (ErrorMode <> 1) Then
'debugging line follows
'Response.Write fld
GetFieldValueSafe = paramRS.fields(fld).value
Else
GetFieldValueSafe = ""
End If
End Function
Sub UpdateField (fld, rs)
Dim val, pos
val = Request(fld)
Select case rs.fields(fld).type
Case 11 'yes/no
If val <> "" Then
rs.fields(fld).value = val
Else
rs.fields(fld).value = "False"
End If
Case 3 'number
If (val = "-1") AND (Instr(fld, "ID")) Then
'used for "(select one)" option in combo boxes -- field should get null in this case
rs.fields(fld).value = Null
Else
If val ="" Then
rs.fields(fld).value = Null
Else
'debugging
' Response.write fld & ":" & val
rs.fields(fld).value = val
End If
End If
Case Else
If fld = "WebPage" Then 'special hook for fixing web page address format
pos = Instr(UCase(val), "HTTP://")
If pos = 1 Then
val = Mid(val, 8, len(val) - 7)
End If
End If
If val <> "" Then
rs.fields(fld).value = val
Else
rs.fields(fld).value = Null
End If
End Select
End Sub
'new version with errors just above the appropriate field
Sub WriteTableRow (fldName, fldValue, fldSize, fldMaxSize, errormode, errormsg, fldDisplayName)
'errormode: 0 = everything's fine
'1 = error(s)
'2 = adding a new record
If errorset.Exists(fldName) Then
Response.Write "
"
If errormode = 1 Then
Response.Write ""
Else
Response.Write ""
End If
Response.Write errorset.Item(fldName)
Response.Write ""
Response.Write "
"
End If
Response.Write "
"
If errorset.Exists(fldName) and errormode = 1 Then Response.Write ""
If fldDisplayName = "" Then
Response.Write fldName
Else
Response.Write fldDisplayName
End If
If errorset.exists(fld) Then Response.Write ""
Response.Write "
"
Response.Write "
"
Response.Write vbcrlf
End Sub
Function GetAppropriateValue(fld, RSss, errormode)
Select Case errormode
Case 1 'error -- take from post
GetAppropriateValue = Request(fld)
Case 0 'no error -- take from database
GetAppropriateValue = GetFieldValueSafe(RSss, fld)
Case 2 'adding new record
GetAppropriateValue = ""
End Select
End Function
Sub WriteTableClassificationItem (rs, fld, fldDisplayName, errormode)
Dim v
v=GetFieldValueSafe(rs, fld)
If errormode = 1 Then v = Request(fld)
' debugging line follows
' Response.Write fld & ":" & v & ";"
Response.Write ""
If Len(fld)=1 Then
Response.Write GetLongNameOfABC(fld)
Else
If fldDisplayName="" Then
Response.Write fld
Else
Response.Write fldDisplayName
End If
End If
Response.Write " " & vbCrLf
End Sub
Sub WriteActivityTextBox (RS2, fldName, fldDisplayName, numRows, numCols)
Response.Write ""
If fldDisplayName = "" Then
Response.Write fldName & ": "
Else
Response.Write fldDisplayName & ": "
End If
Response.Write " "
End Sub
Sub AddToErrors (errorset, errorkey, errormsg)
errorset.Add errorkey, errormsg
' errors = errors & "
" & errormsg & "
"
End Sub
Function GetLongNameOfState (state)
Dim conn, RS
Set Conn = Server.CreateObject("ADODB.Connection")
Conn.Open "TheStand"
sql = "Select LongName from tStates Where State='" & Request("State") & "'"
Set RS = Conn.execute (sql)
If RS.EOF Then GetLongNameOfState = "" Else GetLongNameOfState = RS("LongName")
End Function
%>
