<% 'JAVASCRIPT FUNCTIONS %>
<% 'STYLE SHEETS %>
<%
'======================================================================
Function IsEmail(theEmail)
'======================================================================
If Len(theEmail) > 5 Then
If InStr(theEmail, "@") > 0 Then
IsEmail = True
Else
IsEmail = False
End If
Else
IsEmail = False
End If
End Function
'======================================================================
Function displayMessage(theMessage, theURL, thePage)
' displays a message to the screen, with or without a url
'======================================================================
strMessage = theMessage
strURL = theURL
strPage = thePage
Response.Write "
"
Response.Write ""
Response.Write ""
Response.Write "" & strMessage & "
"
If theURL <> "" And thePage <> "" Then
Response.Write "Back to " & strPage & ""
End If
Response.Write " | "
Response.Write " "
Response.Write " "
End Function
'======================================================================
Function GetLastDay(theMonth, theYear)
' calculates the last day of a month
'======================================================================
' Get the month number
intMonthNum = theMonth
' Get the year number
intYearNum = theYear
' Start the "last day" of the month at 28
intResult = 28
' now we create the date for each day after 28 to see if it still falls within this month
For intLastDay = intResult To 31
'Response.Write "INTLASTDAY" & intResult & ":
"
datTestDay = DateSerial(intYearNum, intMonthNum, intLastDay)
If CStr(Month(datTestDay)) = CStr(intMonthNum) Then
intResult = intLastDay
End If
Next
GetLastDay = intResult
End Function
'======================================================================
Function displayNews()
' generates the current news page
'======================================================================
intThisMonth = Month(Date())
intThisYear = Year(Date())
intLastDay = GetLastDay(intThisMonth, intThisYear)
strSearch = Request("newsSearch")
Response.Write " "
Response.Write ""
Response.Write "| "
Response.Write " Current News For "
Response.Write MonthName(intThisMonth) & ", " & intThisYear
Response.Write " "
If Request("newsID") <> "" Then
Response.Write "Back to Current News | "
End If
If strSearch <> "" Then
Response.Write "Back to Search Results | "
End If
Response.Write "Search | "
If Session("UserID") <> "" Then
Response.Write "Add a News Item | "
Response.Write "Edit Profile | "
End If
Response.Write "News Archives"
If blnAllowRegistering = True And Session("UserID") = "" Then
Response.Write " | Register"
Response.Write " | Forgotten Password?"
End If
Response.Write " | "
Response.Write ""
If Session("UserID") = "" Then
Call displayLogin()
Else
If Session("IsAdministrator") = True Then
Response.Write "[Admin Options] | "
End If
Response.Write "[Logout]"
End If
Response.Write " | "
Response.Write " "
Response.Write " "
Set conn = Server.CreateObject("ADODB.Connection")
conn.open dbODBCName, dbODBCUsername, dbODBCPassword
Set rs = Server.CreateObject("ADODB.Recordset")
sql = "SELECT * FROM [" & dbTableName & "] WHERE "
'Response.Write Now()
If Request("newsID") <> "" Then
sql = sql & "[" & dbTableName & "].ID = " & Request("newsID") & " "
Else
strStartDate = "01 " & MonthName(DatePart("m", Date)) & " " & DatePart("yyyy", Date)
strEndDate = intLastDay & " " & MonthName(DatePart("m", Date)) & " " & DatePart("yyyy", Date)
sql = sql & "[" & dbTableName & "].[Date] >= '" & strStartDate & "' "
sql = sql & "AND [" & dbTableName & "].[Date] <= '" & strEndDate & "' "
sql = sql & "AND Allow = 1 "
End If
sql = sql & "ORDER BY [" & dbTableName & "].[Date], [" & dbTableName & "].[Headline]"
rs.Open sql, conn, 3, 3
Response.Write " "
If rs.RecordCount > 0 Then
rs.MoveFirst
while Not rs.eof
Response.Write ""
Response.Write ""
If Request("newsID") = "" Then
Response.Write ""
Response.Write "[" & rs("Date") & "] "
Response.Write "" & rs.Fields("Headline").Value & " "
If Session("UserID") = rs("UserID") Or Session("IsAdministrator") = True Then
Response.Write "[Edit] "
Response.Write "[Delete]"
End If
Response.Write ""
rs.MoveNext
Else
Response.Write "" & rs("Date") & ": " & rs("Headline") & ""
If Session("UserID") = rs("UserID") Or Session("IsAdministrator") = True Then
Response.Write "[Edit] "
Response.Write "[Delete] "
End If
If blnAllowFriends = True Then
Response.Write "[Email this news to a friend]"
End If
If (blnAllowFriends = True) Or (Session("UserID") = rs("UserID") Or Session("IsAdministrator") = True) Then
Response.Write "
"
End If
Response.Write Replace(rs("Contents"), vbCrLf, "")
If rs("Image") <> "" Then
Set Image = Server.CreateObject("AspImage.Image")
Image.LoadImage (Server.MapPath(imgDirectory) & "\" & rs("Image")) '"
imgWidth = Image.MaxX + 45
imgHeight = Image.MaxY + 55
Set Image = Nothing
tempString = """#1"" "
tempString = tempString & "onClick=""openwindow('" & imgDirectory & "/" & rs("Image") & "',"
tempString = tempString & "'theImages',"
tempString = tempString & "'" & imgHeight & "',"
tempString = tempString & "'" & imgWidth & "')"">"
Response.Write ""
Response.Write ""
End If
if rs("Image2") <> "" AND numImages > 1 then
Set Image = Server.CreateObject("AspImage.Image")
Image.LoadImage (Server.MapPath(imgDirectory) & "\" & rs("Image2")) '"
imgWidth = Image.MaxX + 45
imgHeight = Image.MaxY + 55
Set Image = Nothing
tempString = """#1"" "
tempString = tempString & "onClick=""openwindow('" & imgDirectory & "/" & rs("Image2") & "',"
tempString = tempString & "'theImages',"
tempString = tempString & "'" & imgHeight & "',"
tempString = tempString & "'" & imgWidth & "')"">"
Response.Write ""
Response.Write ""
end if
if rs("Image3") <> "" AND numImages > 2 then
Set Image = Server.CreateObject("AspImage.Image")
Image.LoadImage (Server.MapPath(imgDirectory) & "\" & rs("Image3")) '"
imgWidth = Image.MaxX + 45
imgHeight = Image.MaxY + 55
Set Image = Nothing
tempString = """#1"" "
tempString = tempString & "onClick=""openwindow('" & imgDirectory & "/" & rs("Image3") & "',"
tempString = tempString & "'theImages',"
tempString = tempString & "'" & imgHeight & "',"
tempString = tempString & "'" & imgWidth & "')"">"
Response.Write ""
Response.Write ""
end if
Response.Write "
"
Response.Write ""
rs.MoveNext
End If
Response.Write " | "
Response.Write " "
Wend
Else
Response.Write ""
Response.Write ""
Response.Write "
No news for this month yet."
Response.Write " | "
Response.Write " "
End If
rs.Close
Set rs = nothing
conn.close
Set conn=nothing
Response.Write " "
End Function
'======================================================================
Function adminNews()
' generates the current news page
'======================================================================
Call securityAdmin()
Set conn = Server.CreateObject("ADODB.Connection")
conn.open dbODBCName, dbODBCUsername, dbODBCPassword
Set rs = Server.CreateObject("ADODB.Recordset")
sql = "SELECT * FROM [" & dbTableName & "] WHERE "
sql = sql & "[" & dbTableName & "].ID = " & Request("newsID")
rs.Open sql, conn, 3, 3
Response.Write ""
If rs.RecordCount > 0 Then
rs.MoveFirst
while Not rs.eof
Response.Write ""
Response.Write ""
Response.Write "" & rs("Date") & ": " & rs("Headline") & ""
Response.Write "[Edit] "
Response.Write "[Delete] "
Response.Write "[Close Window] "
Response.Write "
"
If rs("Image") <> "" Then
Set Image = Server.CreateObject("AspImage.Image")
Image.LoadImage (Server.MapPath(imgDirectory) & "\" & rs("Image")) '"
imgWidth = Image.MaxX + 45
imgHeight = Image.MaxY + 55
Set Image = Nothing
tempString = """#1"" "
tempString = tempString & "onClick=""openwindow('" & imgDirectory & "/" & rs("Image") & "',"
tempString = tempString & "'theImages',"
tempString = tempString & "'" & imgHeight & "',"
tempString = tempString & "'" & imgWidth & "')"">"
Response.Write ""
Response.Write ""
End If
Response.Write Replace(rs("Contents"), vbCrLf, "
")
Response.Write "
"
Response.Write ""
rs.MoveNext
Response.Write " | "
Response.Write " "
Wend
Else
Response.Write ""
Response.Write ""
Response.Write "
No news for this month yet."
Response.Write " | "
Response.Write " "
End If
rs.Close
Set rs = nothing
conn.close
Set conn=nothing
Response.Write " "
End Function
'======================================================================
Function displayNewsArchives()
' generates the news archives page
'======================================================================
Set conn = Server.CreateObject("ADODB.Connection")
conn.open dbODBCName, dbODBCUsername, dbODBCPassword
Set rs = Server.CreateObject("ADODB.Recordset")
sql = "SELECT * FROM [" & dbTableName & "] "
intThisMonth = Request("newsMonth")
intThisYear = Request("newsYear")
If intThisMonth <> "" And intThisYear <> "" Then
intLastDay = GetLastDay(intThisMonth, intThisYear)
strStartDate = "01 " & MonthName(intThisMonth) & " " & intThisYear
strEndDate = intLastDay & " " & MonthName(intThisMonth) & " " & intThisYear
sql = sql & "WHERE [" & dbTableName & "].[Date] >= '" & strStartDate & "' "
sql = sql & "AND [" & dbTableName & "].[Date] <= '" & strEndDate & "' "
sql = sql & "AND Allow = 1 "
sql = sql & "ORDER BY [" & dbTableName & "].[Date], [" & dbTableName & "].[Headline]"
Else
sql = sql & "WHERE Allow = 1 "
sql = sql & "Order By [Date] DESC"
End If
rs.Open sql, conn, 3, 3
Response.Write ""
Response.Write ""
Response.Write "| "
Response.Write " News Archives"
If intThisMonth <> "" And intThisYear <> "" Then
Response.Write " For " & MonthName(intThisMonth) & ", " & intThisYear
End If
Response.Write " "
Response.Write "Back to Current News"
If intThisMonth <> "" And intThisYear <> "" Then
Response.Write " | Back to News Archives"
End If
Response.Write " | Search"
If blnAllowRegistering = True And Session("UserID") = "" Then
Response.Write " | Register"
Response.Write " | Forgotten Password?"
End If
If Session("UserID") <> "" Then
Response.Write " | Add a News Item | "
Response.Write "Edit Profile"
End If
Response.Write " | "
Response.Write ""
If Session("UserID") = "" Then
Call displayLogin()
Else
If Session("IsAdministrator") = True Then
Response.Write "[Admin Options] | "
End If
Response.Write "[Logout]"
End If
Response.Write " | "
Response.Write " "
Response.Write " "
If rs.RecordCount > 0 Then
If intThisMonth <> "" And intThisYear <> "" Then
rs.MoveFirst
Response.Write " "
While Not rs.Eof
Response.Write ""
Response.Write "| "
Response.Write ""
Response.Write "[" & rs("Date") & "] "
Response.Write "" & rs.Fields("Headline").Value & " "
If Session("UserID") = rs("UserID") Or Session("IsAdministrator") = True Then
Response.Write "[Edit] "
Response.Write "[Delete]"
End If
Response.Write ""
Response.Write " | "
Response.Write " "
rs.MoveNext
Wend
Response.Write " "
Else
Response.Write ""
End If
Else
Response.Write " | "
Response.Write "| "
Response.Write "No archived news as yet."
Response.Write " | "
Response.Write " "
End If
rs.Close
Set rs = Nothing
conn.Close
Set conn = Nothing
End Function
'======================================================================
Function displaySpecificNewsArchives()
' generates the archives for a selected month
'======================================================================
intThisMonth = Request("newsMonth")
intThisYear = Request("newsYear")
intLastDay = GetLastDay(intThisMonth, intThisYear)
Set conn = Server.CreateObject("ADODB.Connection")
conn.open dbODBCName, dbODBCUsername, dbODBCPassword
Set rs = Server.CreateObject("ADODB.Recordset")
sql = "SELECT * FROM [" & dbTableName & "] "
sql = sql & "WHERE [" & dbTableName & "].[ID] = " & newsID
rs.Open sql, conn, 3, 3
Response.Write ""
If rs.RecordCount > 0 Then
rs.MoveFirst
Response.Write " "
Response.Write ""
Response.Write ""
Response.Write "" & rs("Date") & ": " & rs("Headline") & ""
If Session("UserID") = rs("UserID") Or Session("IsAdministrator") = True Then
Response.Write "[Edit] "
Response.Write "[Delete] "
End If
If blnAllowFriends = True Then
Response.Write "[Email this news to a friend]"
End If
If (blnAllowFriends = True) Or (Session("UserID") = rs("UserID") Or Session("IsAdministrator") = True) Then
Response.Write "
"
End If
If rs("Image") <> "" Then
Response.Write ""
Response.Write "![]() "
Response.Write ""
End If
Response.Write Replace(rs("Contents"), vbCrLf, "
")
Response.Write ""
Response.Write " | "
Response.Write " "
Response.Write " "
Else
Response.Write " "
Response.Write ""
Response.Write "| "
Response.Write "This article no longer exists."
Response.Write " | "
Response.Write " "
Response.Write " "
End If
rs.Close
Set rs = Nothing
conn.close
Set conn = Nothing
'======================================================================
End Function
'======================================================================
'======================================================================
Function displayEditingNews()
' Generates the page to add a news item to the database or to edit an item in the database
'======================================================================
Call execSecurity()
Response.Write ""
Response.Write ""
Response.Write "| "
Response.Write " Add News "
Response.Write "Back to Current News"
Response.Write " | "
Response.Write ""
If Session("UserID") = "" Then
Call displayLogin()
Else
If Session("IsAdministrator") = True Then
Response.Write "[Admin Options] | "
End If
Response.Write "[Logout]"
End If
Response.Write " | "
Response.Write " "
Response.Write " "
'------------------------------------------------------------------------------------------------------------------------------
If blnAllowImage = True Then
'------------------------------------------------------------------------------------------------------------------------------
' This news is allowed to have an image, so we get the necissary details using SAFileUp
Set upl = Server.CreateObject("SoftArtisans.FileUp")
upl.Path = Server.MapPath(imgDirectory)
newsSubmit = upl.Form("newsSubmit")
newsUserID = upl.Form("newsUserID")
newsDate = Date()
newsHeadline = upl.Form("newsHeadline")
newsContents = upl.Form("newsContents")
newsSubmittedBy = upl.Form("newsSubmittedBy")
newsEmail = upl.Form("newsEmail")
newsOldImage = upl.Form("newsOldImage")
newsOldImage2 = upl.Form("newsOldImage2")
newsOldImage3 = upl.Form("newsOldImage3")
If numImages > 1 then
newsOldImage2 = upl.Form("newsOldImage2")
End If
If numImages > 2 then
newsOldImage3 = upl.Form("newsOldImage3")
End If
newsMethod = " enctype=""multipart/form-data"""
Else
' This news is not permitted an image. We request the values from the form.
newsSubmit = Request.Form("newsSubmit")
newsUserID = Request.Form("newsUserID")
newsDate = Date()
newsHeadline = Request.Form("newsHeadline")
newsContents = Request.Form("newsContents")
newsSubmittedBy = Request.Form("newsSubmittedBy")
newsEmail = Request.Form("newsEmail")
'------------------------------------------------------------------------------------------------------------------------------
End If
'------------------------------------------------------------------------------------------------------------------------------
If blnEditThisNews = True Then
formAction = "newsEdit"
Else
formAction = "newsAddNews"
End If
'------------------------------------------------------------------------------------------------------------------------------
Select Case newsSubmit
'------------------------------------------------------------------------------------------------------------------------------
Case "Cancel"
'------------------------------------------------------------------------------------------------------------------------------
' The user is canceling the operation
Response.Redirect(constMyName)
Response.End
'------------------------------------------------------------------------------------------------------------------------------
Case "Add News"
'------------------------------------------------------------------------------------------------------------------------------
newsCheckForm = False
blnImageError = False
If (newsHeadline <> "") And (newsContents <> "") And (newsSubmittedBy <> "") And (newsEmail <> "") Then '4
newsCheckForm = True
Else
newsCheckForm = False
End If
Select Case newsCheckForm
Case True
If blnEditThisNews = False Then
sql = "SELECT * FROM [" & dbTableName & "]"
Set conn = Server.CreateObject("ADODB.Connection")
Set rs = Server.CreateObject("ADODB.RecordSet")
conn.open dbODBCName, dbODBCUsername, dbODBCPassword
rs.Open sql, conn, 1, 2
rs.AddNew
rs("UserID") = newsUserID
rs("Date") = newsDate
rs("Headline") = newsHeadline
rs("Contents") = newsContents
rs("SubmittedBy") = newsSubmittedBy
rs("EmailAddress") = newsEmail
If blnAllowAnyone = True Then
rs("Allow") = True
Else
If Session("IsAdministrator") = True Then
rs("Allow") = True
Else
rs("Allow") = False
End If
End If
rs.Update
newsID = rs("ID")
If blnAllowImage = True Then
If upl.Form("newsImage").UserFileName <> "" Then
tmpName = upl.Form("newsImage").UserFileName
strExtension = LCase(Right(tmpName, 3))
If strExtension = "jpg" Then
strFileName = Replace(CStr(newsDate), "/", "-") & "_" & newsID & "_large." & strExtension
End If
End If
rs("Image") = strFileName
if numImages > 1 then
If upl.Form("newsImage2").UserFileName <> "" Then
tmpName = upl.Form("newsImage2").UserFileName
strExtension = LCase(Right(tmpName, 3))
If strExtension = "jpg" Then
strFileName2 = Replace(CStr(newsDate), "/", "-") & "_" & newsID & "_large2." & strExtension
End If
End If
rs("Image2") = strFileName2
End IF
If numImages > 2 then
If upl.Form("newsImage3").UserFileName <> "" Then
tmpName = upl.Form("newsImage3").UserFileName
strExtension = LCase(Right(tmpName, 3))
If strExtension = "jpg" Then
strFileName3 = Replace(CStr(newsDate), "/", "-") & "_" & newsID & "_large3." & strExtension
End If
End If
rs("Image3") = strFileName3
End If
End If
rs.Update
newsID = rs("ID")
rs.Close
Set rs = nothing
conn.close
Set conn = nothing
If blnAllowAnyone = True Then
displayMessage "Your News Article has been added to the site.", "", ""
Else
displayMessage "Your News has been added to the site. It will be viewable once it is approved by a system administrator.", "", ""
End If
End If
If blnAllowImage = True Then
strExtension = "jpg"
If upl.Form("newsImage").UserFileName <> "" AND LCase(Right(upl.Form("newsImage").UserFileName, 3)) = "jpg" Then
' The First Picture Upload Section
'=============================================================================
If newsOldImage <> "" Then
Set fso = Server.CreateObject("Scripting.FileSystemObject")
If fso.FileExists(Server.MapPath(imgDirectory & "/" & newsOldImage)) = True then
fso.DeleteFile Server.MapPath(imgDirectory & "/" & newsOldImage)
End If
If fso.FileExists(Server.MapPath(imgDirectory & "/" & Replace(newsOldImage, "large", "small"))) = True then
fso.DeleteFile Server.MapPath(imgDirectory & "/" & Replace(newsOldImage, "large", "small"))
End If
Set fso = Nothing
End If
strFileName = Replace(CStr(newsDate), "/", "-") & "_" & newsID & "_large." & strExtension
upl.Form("newsImage").SaveAs upl.Path & "\" & strFileName '"
Size = intThumbnailSize
Set Image = Server.CreateObject("AspImage.Image")
Image.LoadImage (upl.Path & "\" & strFileName) '"
Width = Image.MaxX
Height = Image.MaxY
If Width < Size Then
Size = Width
End If
If Width > Height Then
NewWidth = Round(Size/Width,2)
NewHeight = Int(NewWidth*Height)
Image.Resize Size,NewHeight
Else
NewHeight = Round(Size/Height,2)
NewWidth = Int(NewHeight*Width)
Image.Resize NewWidth,Size
End If
Image.CreateButton 0, False
Image.ImageFormat = 1
Image.JPEGQuality = 50
ProgressiveJPEGEncoding = False
Image.Filename = upl.Path & "\" & Replace(strFileName, "_large", "_small") '"
Image.SaveImage
Set Image = Nothing
End If
if numImages > 1 Then
If upl.Form("newsImage2").UserFileName <> "" AND LCase(Right(upl.Form("newsImage2").UserFileName, 3)) = "jpg" Then
' The Second Picture Upload Section
'=============================================================================
If newsOldImage2 <> "" Then
Set fso = Server.CreateObject("Scripting.FileSystemObject")
If fso.FileExists(Server.MapPath(imgDirectory & "/" & newsOldImage2)) = True then
fso.DeleteFile Server.MapPath(imgDirectory & "/" & newsOldImage2)
end if
If fso.FileExists(Server.MapPath(imgDirectory & "/" & Replace(newsOldImage2, "large", "small"))) = True then
fso.DeleteFile Server.MapPath(imgDirectory & "/" & Replace(newsOldImage2, "large", "small"))
End If
Set fso = Nothing
End If
strFileName2 = Replace(CStr(newsDate), "/", "-") & "_" & newsID & "_large2." & strExtension
upl.Form("newsImage2").SaveAs upl.Path & "\" & strFileName2 '"
Size = intThumbnailSize
Set Image = Server.CreateObject("AspImage.Image")
Image.LoadImage (upl.Path & "\" & strFileName2) '"
Width = Image.MaxX
Height = Image.MaxY
If Width < Size Then
Size = Width
End If
If Width > Height Then
NewWidth = Round(Size/Width, 2)
NewHeight = Int(NewWidth * Height)
Image.Resize Size, NewHeight
Else
NewHeight = Round(Size/Height,2)
NewWidth = Int(NewHeight*Width)
Image.Resize NewWidth,Size
End If
Image.CreateButton 0, False
Image.ImageFormat = 1
Image.JPEGQuality = 50
ProgressiveJPEGEncoding = False
Image.Filename = upl.Path & "\" & Replace(strFileName2, "_large", "_small") '"
Image.SaveImage
Set Image = Nothing
End If
End If
if numImages > 2 Then
If upl.Form("newsImage3").UserFileName <> "" AND LCase(Right(upl.Form("newsImage3").UserFileName, 3)) = "jpg" Then
' The Third Picture Upload Section
'=============================================================================
If newsOldImage3 <> "" Then
Set fso = Server.CreateObject("Scripting.FileSystemObject")
If fso.FileExists(Server.MapPath(imgDirectory & "/" & newsOldImage3)) = True then
fso.DeleteFile Server.MapPath(imgDirectory & "/" & newsOldImage3)
End IF
If fso.FileExists(Server.MapPath(imgDirectory & "/" & Replace(newsOldImage3, "large", "small"))) = True then
fso.DeleteFile Server.MapPath(imgDirectory & "/" & Replace(newsOldImage3, "large", "small"))
End If
Set fso = Nothing
End If
strFileName3 = Replace(CStr(newsDate), "/", "-") & "_" & newsID & "_large3." & strExtension
upl.Form("newsImage3").SaveAs upl.Path & "\" & strFileName3 '"
Size = intThumbnailSize
Set Image = Server.CreateObject("AspImage.Image")
Image.LoadImage (upl.Path & "\" & strFileName3) '"
Width = Image.MaxX
Height = Image.MaxY
If Width < Size Then
Size = Width
End If
If Width > Height Then
NewWidth = Round(Size/Width,2)
NewHeight = Int(NewWidth*Height)
Image.Resize Size,NewHeight
Else
NewHeight = Round(Size/Height,2)
NewWidth = Int(NewHeight*Width)
Image.Resize NewWidth,Size
End If
Image.CreateButton 0, false
Image.ImageFormat = 1
Image.JPEGQuality = 50
ProgressiveJPEGEncoding = False
Image.Filename = upl.Path & "\" & Replace(strFileName3, "_large", "_small") '"
Image.SaveImage
Set Image = nothing
Set upl = Nothing
End If
End IF
'Case Else
'blnImageError = True
''newsCheckForm = False
'displayMessage "There was a problem saving your file. Please make sure it is a .jpg file.", "", ""
'End Select'
End If
'End If
Case False
newsCheckForm = False
displayMessage "All the fields on this form are compulsory. Please check all information has been entered correctly and resubmit all information. Thank you.", "", ""
Case Else
displayMessage "All the fields on this form are compulsory. Please check all information has been entered correctly before submitting. Thank you.", "", ""
End Select
If blnImageError = False And newsCheckForm = True Then
If blnEditThisNews = True Then
' The user is editing the news, not adding a new news item
sql = "SELECT * FROM [" & dbTableName & "] WHERE ID = " & newsID
Set conn = Server.CreateObject("ADODB.Connection")
Set rs = Server.CreateObject("ADODB.RecordSet")
conn.open dbODBCName, dbODBCUsername, dbODBCPassword
rs.Open sql, conn, 1, 2
rs.MoveFirst
rs("UserID") = newsUserID
rs("Date") = newsDate
rs("Headline") = newsHeadline
rs("Contents") = newsContents
rs("SubmittedBy") = newsSubmittedBy
rs("EmailAddress") = newsEmail
If strFileName <> "" Then
rs("Image") = strFileName
End If
If strFileName2 <> "" Then
rs("Image2") = strFileName2
End If
If strFileName3 <> "" Then
rs("Image3") = strFileName3
End If
rs.Update
rs.Close
Set rs = nothing
conn.close
Set conn = nothing
displayMessage "Your News Article has been updated.", "", ""
End If
End If
Case "Restore Old Values"
' The user is requesting the old values be restored to the form
sql = "SELECT * FROM [" & dbTableName & "] WHERE ID =" & newsID
Set conn = Server.CreateObject("ADODB.Connection")
Set rs = Server.CreateObject("ADODB.RecordSet")
conn.open dbODBCName, dbODBCUsername, dbODBCPassword
rs.Open sql, conn, 3, 3
rs.MoveFirst
newsUserID = rs("UserID")
newsDate = rs("Date")
newsHeadline = rs("Headline")
newsContents = rs("Contents")
newsSubmittedBy = rs("SubmittedBy")
newsEmail = rs("EmailAddress")
newsImage = rs("Image")
newsImage2 = rs("Image2")
newsImage3 = rs("Image3")
rs.Close
Set rs = Nothing
conn.close
Set conn = Nothing
Case ""
If blnEditThisNews = True Then
sql = "SELECT * FROM [" & dbTableName & "] WHERE ID =" & newsID
Set conn = Server.CreateObject("ADODB.Connection")
Set rs = Server.CreateObject("ADODB.RecordSet")
conn.open dbODBCName, dbODBCUsername, dbODBCPassword
rs.Open sql, conn, 3, 3
rs.MoveFirst
newsUserID = rs("UserID")
newsDate = rs("Date")
newsHeadline = rs("Headline")
newsContents = rs("Contents")
newsSubmittedBy = rs("SubmittedBy")
newsEmail = rs("EmailAddress")
newsOldImage = rs("Image")
newsOldImage2 = rs("Image2")
newsOldImage3 = rs("Image3")
rs.Close
Set rs = Nothing
conn.close
Set conn = Nothing
End If
End Select
If newsCheckForm <> True Then
If newsSubmittedBy = "" Then
newsSubmittedBy = Session("UserName")
End If
If newsEmail = "" Then
newsEmail = Session("UserEmail")
End If
If newsUserID = "" Then
newsUserID = Session("UserID")
End If
Response.Write " "
Response.Write ""
Response.Write "| "
Response.Write ""
Response.Write " | "
Response.Write " "
Response.Write " "
End If
End Function
'======================================================================
Function adminEdit()
' Generates the page to add a news item to the database or to edit an item in the database
'======================================================================
Call securityAdmin()
'------------------------------------------------------------------------------------------------------------------------------
If blnAllowImage = True Then '3
'------------------------------------------------------------------------------------------------------------------------------
' This news is allowed to have an image, so we get the necissary details using SAFileUp
Set upl = Server.CreateObject("SoftArtisans.FileUp")
upl.Path = Server.MapPath(imgDirectory)
newsSubmit = upl.Form("newsSubmit")
newsUserID = upl.Form("newsUserID")
newsDate = Date()
newsHeadline = upl.Form("newsHeadline")
newsContents = upl.Form("newsContents")
newsSubmittedBy = upl.Form("newsSubmittedBy")
newsEmail = upl.Form("newsEmail")
newsOldImage = upl.Form("newsOldImage")
newsOldImage1 = upl.Form("newsOldImage1")
newsOldImage2 = upl.Form("newsOldImage2")
newsMethod = " enctype=""multipart/form-data"""
Else
' This news is not permitted an image. We request the values from the form.
newsSubmit = Request.Form("newsSubmit")
newsUserID = Request.Form("newsUserID")
newsDate = Date()
newsHeadline = Request.Form("newsHeadline")
newsContents = Request.Form("newsContents")
newsSubmittedBy = Request.Form("newsSubmittedBy")
newsEmail = Request.Form("newsEmail")
'------------------------------------------------------------------------------------------------------------------------------
End If
'------------------------------------------------------------------------------------------------------------------------------
formAction = "adminEdit"
'------------------------------------------------------------------------------------------------------------------------------
Select Case newsSubmit
'------------------------------------------------------------------------------------------------------------------------------
Case "Cancel"
'------------------------------------------------------------------------------------------------------------------------------
' The user is canceling the operation
Response.Redirect(constMyName & "?newsAction=adminNews&newsID=" & newsID)
'------------------------------------------------------------------------------------------------------------------------------
Case "Add News"
'------------------------------------------------------------------------------------------------------------------------------
newsCheckForm = False
blnImageError = False
If (newsHeadline <> "") And (newsContents <> "") And (newsSubmittedBy <> "") And (newsEmail <> "") Then '4
newsCheckForm = True
Else
newsCheckForm = False
End If
Select Case newsCheckForm
Case True
If blnAllowImage = True Then
If upl.Form("newsImage").IsEmpty = False And IsObject(upl.Form("newsImage")) Then
tmpName = upl.Form("newsImage").UserFilename
strExtension = LCase(Right(tmpName, 3))
Select Case strExtension
Case "jpg"
' The First Picture Upload Section
'================================================================
If newsOldImage <> "" Then
Set fso = Server.CreateObject("Scripting.FileSystemObject")
fso.DeleteFile Server.MapPath(imgDirectory & "/" & newsOldImage)
fso.DeleteFile Server.MapPath(imgDirectory & "/" & Replace(newsOldImage, "large", "small"))
Set fso = Nothing
End If
IF upl.Form("newsImage") <> "" then
strFileName = Replace(CStr(newsDate), "/", "-") & "_" & newsID & "_large." & strExtension
upl.Form("newsImage").SaveAs upl.Path & "\" & strFileName
Size = intThumbnailSize
Set Image = Server.CreateObject("AspImage.Image")
Image.LoadImage (upl.Path & "\" & strFileName) '"
Width = Image.MaxX
Height = Image.MaxY
If Width < Size Then
Size = Width
End If
If Width > Height Then
NewWidth = Round(Size/Width,2)
NewHeight = Int(NewWidth*Height)
Image.Resize Size,NewHeight
Else
NewHeight = Round(Size/Height,2)
NewWidth = Int(NewHeight*Width)
Image.Resize NewWidth,Size
End If
Image.CreateButton 5, true
Image.ImageFormat = 1
Image.JPEGQuality = 50
ProgressiveJPEGEncoding = False
Image.Filename = upl.Path & "\" & Replace(strFileName, "_large", "_small") '"
Image.SaveImage
End IF
If numImages > 1 then
' The Second Image Upload Section
'================================================================
If newsOldImage1 <> "" Then
Set fso = Server.CreateObject("Scripting.FileSystemObject")
fso.DeleteFile Server.MapPath(imgDirectory & "/" & newsOldImage1)
fso.DeleteFile Server.MapPath(imgDirectory & "/" & Replace(newsOldImage1, "large", "small"))
Set fso = Nothing
End If
If upl.Form("newsImage1") <> "" then
strFileName1 = Replace(CStr(newsDate), "/", "-") & "_" & newsID & "_large2." & strExtension
upl.Form("newsImage1").SaveAs upl.Path & "\" & strFileName1 '"
Size = intThumbnailSize
Set Image = Server.CreateObject("AspImage.Image")
Image.LoadImage (upl.Path & "\" & strFileName1) '"
Width = Image.MaxX
Height = Image.MaxY
If Width < Size Then
Size = Width
End If
If Width > Height Then
NewWidth = Round(Size/Width,2)
NewHeight = Int(NewWidth*Height)
Image.Resize Size,NewHeight
Else
NewHeight = Round(Size/Height,2)
NewWidth = Int(NewHeight*Width)
Image.Resize NewWidth,Size
End If
Image.CreateButton 5, true
Image.ImageFormat = 1
Image.JPEGQuality = 50
ProgressiveJPEGEncoding = False
Image.Filename = upl.Path & "\" & Replace(strFileName1, "_large", "_small") '"
Image.SaveImage
End IF
End IF
IF numImages > 2 then
' The Third Picture Upload Section
'================================================================
If newsOldImage2 <> "" Then
Set fso = Server.CreateObject("Scripting.FileSystemObject")
fso.DeleteFile Server.MapPath(imgDirectory & "/" & newsOldImage2)
fso.DeleteFile Server.MapPath(imgDirectory & "/" & Replace(newsOldImage2, "large", "small"))
Set fso = Nothing
End If
if upl.Form("newsImage2") <> "" then
strFileName2 = Replace(CStr(newsDate), "/", "-") & "_" & newsID & "_large3." & strExtension
upl.Form("newsImage2").SaveAs upl.Path & "\" & strFileName2 '"
Size = intThumbnailSize
Set Image = Server.CreateObject("AspImage.Image")
Image.LoadImage (upl.Path & "\" & strFileName2) '"
Width = Image.MaxX
Height = Image.MaxY
If Width < Size Then
Size = Width
End If
If Width > Height Then
NewWidth = Round(Size/Width,2)
NewHeight = Int(NewWidth*Height)
Image.Resize Size,NewHeight
Else
NewHeight = Round(Size/Height,2)
NewWidth = Int(NewHeight*Width)
Image.Resize NewWidth,Size
End If
Image.CreateButton 5, true
Image.ImageFormat = 1
Image.JPEGQuality = 50
ProgressiveJPEGEncoding = False
Image.Filename = upl.Path & "\" & Replace(strFileName2, "_large", "_small") '"
Image.SaveImage
End IF
Set Image = nothing
Set upl = Nothing
End IF
Case Else
blnImageError = True
newsCheckForm = False
displayMessage "There was a problem saving your file. Please make sure it is a .jpg file.", "", ""
End Select
End If
End If
Case False
newsCheckForm = False
displayMessage "All the fields on this form are compulsory. Please check all information has been entered correctly and resubmit all information. Thank you.", "", ""
Case Else
displayMessage "All the fields on this form are compulsory. Please check all information has been entered correctly before submitting. Thank you.", "", ""
End Select
If blnImageError = False And newsCheckForm = True Then
' The user is editing the news, not adding a new news item
sql = "SELECT * FROM [" & dbTableName & "] WHERE ID = " & newsID
Set conn = Server.CreateObject("ADODB.Connection")
Set rs = Server.CreateObject("ADODB.RecordSet")
conn.open dbODBCName, dbODBCUsername, dbODBCPassword
rs.Open sql, conn, 1, 2
rs.MoveFirst
rs("UserID") = newsUserID
rs("Date") = newsDate
rs("Headline") = newsHeadline
rs("Contents") = newsContents
rs("SubmittedBy") = newsSubmittedBy
rs("EmailAddress") = newsEmail
If strFileName <> "" Then
rs("Image") = strFileName
End If
If strFileName1 <> "" Then
rs("Image2") = strFileName
End If
If strFileName2 <> "" Then
rs("Image3") = strFileName
End If
rs.Update
rs.Close
Set rs = nothing
conn.close
Set conn = nothing
Response.Write "" & vbCrLf
End If
Case "Restore Old Values"
' The user is requesting the old values be restored to the form
sql = "SELECT * FROM [" & dbTableName & "] WHERE ID =" & newsID
Set conn = Server.CreateObject("ADODB.Connection")
Set rs = Server.CreateObject("ADODB.RecordSet")
conn.open dbODBCName, dbODBCUsername, dbODBCPassword
rs.Open sql, conn, 3, 3
rs.MoveFirst
newsUserID = rs("UserID")
newsDate = rs("Date")
newsHeadline = rs("Headline")
newsContents = rs("Contents")
newsSubmittedBy = rs("SubmittedBy")
newsEmail = rs("EmailAddress")
newsImage = rs("Image")
newsImage2 = rs("Image2")
newsImage3 = rs("Image3")
rs.Close
Set rs = Nothing
conn.close
Set conn = Nothing
Case ""
sql = "SELECT * FROM [" & dbTableName & "] WHERE ID =" & newsID
Set conn = Server.CreateObject("ADODB.Connection")
Set rs = Server.CreateObject("ADODB.RecordSet")
conn.open dbODBCName, dbODBCUsername, dbODBCPassword
rs.Open sql, conn, 3, 3
rs.MoveFirst
newsUserID = rs("UserID")
newsDate = rs("Date")
newsHeadline = rs("Headline")
newsContents = rs("Contents")
newsSubmittedBy = rs("SubmittedBy")
newsEmail = rs("EmailAddress")
newsOldImage = rs("Image")
newsOldImage2 = rs("Image2")
newsOldImage3 = rs("Image3")
rs.Close
Set rs = Nothing
conn.close
Set conn = Nothing
End Select
If newsCheckForm <> True Then
If newsSubmittedBy = "" Then
newsSubmittedBy = Session("UserName")
End If
If newsEmail = "" Then
newsEmail = Session("UserEmail")
End If
If newsUserID = "" Then
newsUserID = Session("UserID")
End If
Response.Write ""
Response.Write ""
Response.Write "| "
Response.Write ""
Response.Write " | "
Response.Write " "
Response.Write " "
End If
End Function
'======================================================================
Function displayLogin()
' generates the login section
'======================================================================
Response.Write ""
Response.Write " | Admin use only | "
Response.Write ""
Response.Write ""
Response.Write "| "
Response.Write "Your@Email:"
Response.Write " | "
Response.Write ""
Response.Write "Password:"
Response.Write " | "
Response.Write " "
Response.Write ""
Response.Write " "
Response.Write " |
"
End Function
'======================================================================
Function execLogin()
' Executes a user's request to login
'======================================================================
newsUsername = Request("newsUsername")
newsPassword = Request("newsPassword")
If newsUsername <> "" And newsPassword <> "" Then
sql = "SELECT * FROM [" & dbUsersTableName & "] "
sql = sql & "WHERE [Email] = '" & newsUsername & "' "
sql = sql & "AND [Password] = '" & newsPassword & "' "
Set conn = Server.CreateObject("ADODB.Connection")
Set rs = Server.CreateObject("ADODB.RecordSet")
conn.open dbODBCName, dbODBCUsername, dbODBCPassword
rs.Open sql, conn, 3, 3
If rs.RecordCount > 0 Then
rs.MoveFirst
If rs("Allow") = True Then
Session("UserID") = rs("ID")
Session("UserName") = rs("Name")
Session("UserEmail") = rs("Email")
If rs("IsAdministrator") = True Then
Session("IsAdministrator") = True
End If
Call displayNews()
Else
Response.Write "" & vbCrLf
Call displayNews()
End If
Else
Response.Write "" & vbCrLf
Call displayNews()
End If
rs.Close
Set rs = nothing
conn.close
Set conn = nothing
Else
Response.Write "" & vbCrLf
Call displayNews()
End If
End Function
'======================================================================
Function execLogout()
' Allows the user to logout
'======================================================================
Session("UserID") = ""
Session("UserName") = ""
Session("UserEmail") = ""
Session("IsAdministrator") = False
Response.Redirect("" & constMyName & "")
End Function
'======================================================================
Function execSecurity()
' Security function to make sure a user has logged in before trying to access a utility
'======================================================================
If Session("UserID") = "" Then
Response.Redirect("" & constMyName & "")
End If
End Function
'======================================================================
Function execDelNews()
'======================================================================
Call execSecurity()
sql = "SELECT * FROM [" & dbTableName & "] WHERE ID = " & newsID
Set conn = Server.CreateObject("ADODB.Connection")
Set rs = Server.CreateObject("ADODB.RecordSet")
conn.open dbODBCName, dbODBCUsername, dbODBCPassword
rs.Open sql, conn, 1, 2
rs.MoveFirst
thisImage = rs("Image")
thisImage2 = rs("Image2")
thisImage3 = rs("Image3")
rs.Delete
rs.Update
rs.Close
Set rs = nothing
conn.close
Set conn = nothing
If thisImage <> "" Then
Set fso = Server.CreateObject("Scripting.FileSystemObject")
if fso.FileExists(Server.MapPath(imgDirectory & "/" & thisImage)) = true then
fso.DeleteFile Server.MapPath(imgDirectory & "/" & thisImage)
end if
if fso.FileExists(Server.MapPath(imgDirectory & "/" & thisImage2)) = true then
fso.DeleteFile Server.MapPath(imgDirectory & "/" & thisImage2)
end if
if fso.FileExists(Server.MapPath(imgDirectory & "/" & thisImage3)) = true then
fso.DeleteFile Server.MapPath(imgDirectory & "/" & thisImage3)
end if
if fso.FileExists(Server.MapPath(imgDirectory & "/" & Replace(thisImage, "large", "small"))) = true then
fso.DeleteFile Server.MapPath(imgDirectory & "/" & Replace(thisImage, "large", "small"))
end if
' check to see if thisImage2 actually has data
if len(thisImage2) > 3 then
if fso.FileExists(Server.MapPath(imgDirectory & "/" & Replace(thisImage2, "large", "small"))) = true then
fso.DeleteFile Server.MapPath(imgDirectory & "/" & Replace(thisImage2, "large", "small"))
end if
End if
if len(thisImage3) > 3 then
if fso.FileExists(Server.MapPath(imgDirectory & "/" & Replace(thisImage3, "large", "small"))) = true then
fso.DeleteFile Server.MapPath(imgDirectory & "/" & Replace(thisImage3, "large", "small"))
end if
End if
Set fso = Nothing
End If
End Function
'======================================================================
Function execAdminDelNews()
'======================================================================
Call execSecurity()
sql = "SELECT * FROM [" & dbTableName & "] WHERE ID = " & newsID
Set conn = Server.CreateObject("ADODB.Connection")
Set rs = Server.CreateObject("ADODB.RecordSet")
conn.open dbODBCName, dbODBCUsername, dbODBCPassword
rs.Open sql, conn, 1, 2
rs.MoveFirst
thisImage = rs("Image")
rs.Delete
rs.Update
rs.Close
Set rs = nothing
conn.close
Set conn = nothing
If thisImage <> "" Then
Set fso = Server.CreateObject("Scripting.FileSystemObject")
fso.DeleteFile Server.MapPath(imgDirectory & "/" & thisImage)
fso.DeleteFile Server.MapPath(imgDirectory & "/" & Replace(thisImage, "large", "small"))
Set fso = Nothing
End If
End Function
'======================================================================
Function newsRegister()
'======================================================================
' Call execSecurity()
If blnEditProfile = True Then
thisNewsAction = "newsEditProfile"
If Request("newsSubmit") = "" Or Request("newsSubmit") = "Restore Old Values" Then
newsUserID = Session("UserID")
sql = "SELECT * FROM [" & dbUsersTablename & "] WHERE ID = " & newsUserID
Set conn = Server.CreateObject("ADODB.Connection")
Set rs = Server.CreateObject("ADODB.RecordSet")
conn.open dbODBCName, dbODBCUsername, dbODBCPassword
rs.Open sql, conn, 3, 3
newsName = rs("Name")
newsEmail = rs("Email")
newsPassword = rs("Password")
rs.Close
Set rs = Nothing
conn.close
Set conn = Nothing
End If
Else
thisNewsAction = "newsRegister"
End If
newsSubmit = Request("newsSubmit")
newsCheckForm = False
If newsSubmit = "Cancel" Then
Response.Redirect(constMyName)
End If
If newsSubmit = "Register" Then
newsName = Request("newsName")
newsEmail = Request("newsEmail")
newsPassword = Request("newsPassword")
If (newsName <> "") And (newsEmail <> "") And (newsPassword <> "") Then
If blnEditProfile <> True Then
sql = "SELECT * FROM [" & dbUsersTablename & "] WHERE Email = '" & newsEmail & "'"
Set conn = Server.CreateObject("ADODB.Connection")
Set rs = Server.CreateObject("ADODB.RecordSet")
conn.open dbODBCName, dbODBCUsername, dbODBCPassword
rs.Open sql, conn, 3, 3
If rs.RecordCount > 0 Then
newsCheckForm = False
Else
newsCheckForm = True
End If
rs.Close
Set rs = Nothing
conn.close
Set conn = Nothing
Else
newsCheckForm = True
End IF
Else
newsCheckForm = False
End If
If newsCheckForm <> False Then
sql = "[" & dbUsersTablename & "]"
If blnEditProfile = True Then
sql = sql & " WHERE ID = " & Session("UserID")
End If
Set conn = Server.CreateObject("ADODB.Connection")
Set rs = Server.CreateObject("ADODB.RecordSet")
conn.open dbODBCName, dbODBCUsername, dbODBCPassword
rs.Open sql, conn, 1, 2
If blnEditProfile <> True Then
rs.AddNew
End If
rs("Name") = newsName
rs("Email") = newsEmail
rs("Password") = newsPassword
rs.Update
rs.Close
Set rs = nothing
conn.close
Set conn = nothing
If blnEditProfile <> True Then
If blnAllowAnyone = True Then
displayMessage "Your have successfully registered. You may login immediately.", constMyName, "Current News"
Else
displayMessage "Your have successfully registered. You will be contacted once you have been approved by the system administrator.", constMyName, "Current News"
End If
Else
displayMessage "Your have successfully updated your profile.", constMyName, "Current News"
End If
Else
Response.Write "" & vbCrLf
End If
End If
If newsCheckForm = False Then
Response.Write ""
Response.Write ""
Response.Write "| "
If blnEditProfile = True Then
Response.Write " Edit Profile "
Else
Response.Write "Register "
End If
Response.Write "Back to Current News"
Response.Write ""
Response.Write " | "
Response.Write " "
Response.Write " "
End If
End Function
'======================================================================
Function newsForgotten()
'======================================================================
newsSubmit = Request("newsSubmit")
newsCheckForm = False
If newsSubmit = "Cancel" Then
Response.Redirect(constMyName)
End If
If newsSubmit = "Send me my password" Then
newsEmail = Request("newsEmail")
If (newsEmail <> "") And IsEmail(newsEmail) = True Then
sql = "SELECT * FROM [" & dbUsersTablename & "] WHERE Email = '" & newsEmail & "'"
Set conn = Server.CreateObject("ADODB.Connection")
Set rs = Server.CreateObject("ADODB.RecordSet")
conn.open dbODBCName, dbODBCUsername, dbODBCPassword
rs.Open sql, conn, 3, 3
If rs.RecordCount > 0 Then
newsPassword = rs("Password")
newsName = rs("Name")
newsCheckForm = True
Else
newsCheckForm = False
End If
rs.Close
Set rs = Nothing
conn.close
Set conn = Nothing
Else
newsCheckForm = False
End If
If newsCheckForm <> False Then
Set Mailer = Server.CreateObject("SMTPsvg.Mailer")
Mailer.FromName = strDefaultName
Mailer.FromAddress = strDefaultEmail
Mailer.RemoteHost = "tradepage.co.za"
Mailer.AddRecipient newsName, newsEmail
Mailer.Subject = "Your Username and Password for " & strDefaultName
Mailer.BodyText = "Username: " & newsEmail & VbCrLf
Mailer.BodyText = "Password: " & newsPassword & VbCrLf
If Mailer.SendMail Then
displayMessage "Your password has been emailed to you.", constMyName, "Current News"
Else
displayMessage "There was an error sending the email. The error was " & Mailer.Response & ". Please either try resubmitting the form, or contact " & strDefaultName & " and inform them of the problem.", constMyName, "Current News"
End If
Else
Response.Write "" & vbCrLf
End If
End If
If newsCheckForm = False Then
Response.Write ""
Response.Write ""
Response.Write "| "
Response.Write " Forgotten Password "
Response.Write "Back to Current News"
Response.Write ""
Response.Write " | "
Response.Write " "
Response.Write " "
End If
End Function
'======================================================================
Function newsEmailFriend()
'======================================================================
If blnAllowFriends = True Then
newsSubmit = Request("newsSubmit")
newsCheckForm = False
If newsSubmit = "Cancel" Then
Response.Redirect(constMyName)
End If
If newsSubmit = "Email it!" Then
newsFriendName = Request("newsFriendName")
newsFriendEmail = Request("newsFriendEmail")
newsYourEmail = Request("newsYourEmail")
newsYourName = Request("newsYourName")
newsYourMessage = Request("newsYourMessage")
newsSendImage = Request("newsSendImage")
If (newsYourEmail <> "") And IsEmail(newsYourEmail) = True And newsFriendName <> "" And newsFriendEmail <> "" And IsEmail(newsFriendEmail) = True And newsYourName <> "" Then
newsCheckForm = True
Else
newsCheckForm = False
End If
If newsCheckForm <> False Then
sql = "SELECT * FROM [" & dbTablename & "] WHERE ID = " & newsID
Set conn = Server.CreateObject("ADODB.Connection")
Set rs = Server.CreateObject("ADODB.RecordSet")
conn.open dbODBCName, dbODBCUsername, dbODBCPassword
rs.Open sql, conn, 3, 3
rs.MoveFirst
newsHeadline = rs("Headline")
newsDate = rs("Date")
newsName = rs("SubmittedBy")
newsContents = rs("Contents")
newsImage = rs("Image")
newsImage2 = rs("Image2")
newsImage3 = rs("Image3")
newsEmail = rs("EmailAddress")
rs.Close
Set rs = Nothing
conn.close
Set conn = Nothing
Set Mailer = Server.CreateObject("SMTPsvg.Mailer")
Mailer.FromName = newsYourName
Mailer.FromAddress = newsYourEmail
Mailer.RemoteHost = "tradepage.co.za"
Mailer.AddRecipient newsFriendName, newsFriendEmail
Mailer.Subject = newsYourName & " has sent you news from " & strDefaultWebsite
Mailer.BodyText = "Hi " & newsFriendName & "! "
Mailer.BodyText = newsYourName & " has sent you the following news article taken from " & strDefaultWebsite & "!" & vbCrLf & vbCrLf
Mailer.BodyText = "If you wish to send email to " & newsYourName & ", then just reply to this message. " & vbCrLf & vbCrLf
Mailer.BodyText = newsYourName & " also had the following message for you: " & vbCrLf
Mailer.BodyText = newsYourMessage & vbCrLf & vbCrLf & " -- Begin News -- " & vbCrLf
Mailer.BodyText = "Title: " & newsHeadline & VbCrLf
Mailer.BodyText = "Written by: " & newsName & " [ " & newsEmail & " ] on " & FormatDateTime(CDate(newsDate), 1) & VbCrLf & VbCrLf
Mailer.BodyText = newsContents
If newsImage <> "" And newsSendImage <> "" Then
Mailer.AddAttachment Server.MapPath(imgDirectory & "/" & newsImage)
End If
If newsImage2 <> "" And newsSendImage <> "" ANd numImages > 1 then
Mailer.AddAttachment Server.MapPath(imgDirectory & "/" & newsImage2)
End If
If newsImage3 <> "" And newsSendImage <> "" ANd numImages > 2 then
Mailer.AddAttachment Server.MapPath(imgDirectory & "/" & newsImage3)
End If
If Mailer.SendMail Then
displayMessage "You have succesffully sent this news item to " & newsFriendName & ".", constMyName, "Current News"
Else
displayMessage "There was an error sending the email. The error was " & Mailer.Response & ". Please either try resubmitting the form, or contact " & strDefaultName & " and inform us of the problem.", constMyName, "Current News"
End If
Else
Response.Write "" & vbCrLf
End If
End If
If newsCheckForm = False Then
Response.Write ""
Response.Write ""
Response.Write "| "
Response.Write " Email News to a Friend "
Response.Write "Back to Current News"
Response.Write ""
Response.Write " | "
Response.Write " "
Response.Write " "
End If
Else
Response.Redirect(constMyName)
End If
End Function
'======================================================================
Function displaySearch()
'======================================================================
strSearch = Request("frmSearch")
newsSubmit = Request("newsSubmit")
Select Case newsSubmit
Case "Search"
If strSearch = "" Then
blnSearchResults = False
Response.Write "" & vbCrLf
Else
blnSearchResults = True
End if
Case "Cancel"
Response.Redirect(constMyName)
Case ""
If strSearch <> "" Then
blnSearchResults = True
End If
End Select
Response.Write ""
Response.Write ""
Response.Write "| "
Response.Write " Search the News "
Response.Write "Back to Current News"
Response.Write ""
Response.Write " | "
Response.Write " "
Response.Write " "
If blnSearchResults = True Then
strFixSearch = strSearch
If InStr(strFixSearch, "'") > 0 Then
aposPos = InStr(strFixSearch, "'")
strFixSearch = Left(strFixSearch, aposPos-1)
blnApostrophy = True
End If
sql = "SELECT * FROM [" & dbTablename & "] WHERE "
sql = sql & "[Headline] LIKE '" & strFixSearch & "%' OR "
sql = sql & "[Headline] LIKE '% " & strFixSearch & "%' OR "
sql = sql & "[Contents] LIKE '" & strFixSearch & "%' OR "
sql = sql & "[Contents] LIKE '% " & strFixSearch & "%' OR "
sql = sql & "[SubmittedBy] LIKE '" & strFixSearch & "%' OR "
sql = sql & "[SubmittedBy] LIKE ' " & strFixSearch & "%' AND "
sql = sql & "[Allow] = 1 "
sql = sql & " ORDER BY [Date], [SubmittedBy], [Headline]"
Set conn = Server.CreateObject("ADODB.Connection")
Set rs = Server.CreateObject("ADODB.RecordSet")
conn.open dbODBCName, dbODBCUsername, dbODBCPassword
rs.Open sql, conn, 3, 3
If rs.RecordCount > 0 Then
Response.Write ""
Response.Write ""
Response.Write "| "
If rs.RecordCount > 1 Then
strMatches = "Matches"
Else
strMatches = "Match"
End If
Response.Write " " & rs.RecordCount & " " & strMatches & " for " & strFixSearch & " "
If blnApostrophy = True Then
Response.Write "The apostrophy is a reserved word and cannot be searched for. These search results are based upon all the letters to the left of the apostrophy."
End If
Response.Write " | "
Response.Write " "
rs.MoveFirst
While Not rs.Eof
Response.Write ""
Response.Write "| "
Response.Write ""
Response.Write "[" & rs("Date") & "] "
Response.Write "" & rs.Fields("Headline").Value & " "
If Session("UserID") = rs("UserID") Then
Response.Write "[Edit] "
Response.Write "[Delete]"
End If
Response.Write ""
Response.Write " | "
Response.Write " "
rs.MoveNext
Wend
Response.Write " "
Else
displayMessage "There were no results matching " & strSearch & ". Please try again.", "", ""
End If
End If
'======================================================================
End Function
'======================================================================
'======================================================================
Function securityAdmin()
'======================================================================
If Session("IsAdministrator") <> True Then
Response.Redirect(constMyName)
End If
'======================================================================
End Function
'======================================================================
'======================================================================
Function adminMain()
'======================================================================
Call adminHeader()
'======================================================================
End Function
'======================================================================
'======================================================================
Function adminHeader()
'======================================================================
Call securityAdmin()
Response.Write ""
End Function
'======================================================================
Sub PageNavBar(sql, thepage, thepagesize, themaxpages)
'======================================================================
strSQL = sql
mypage = thepage
mypagesize = thepagesize
maxpages = themaxpages
' Thanks to Jeff Emrich
pad=""
scriptname=request.servervariables("script_name")
Response.Write ""
Response.Write ""
Response.Write ""
if (mypage mod 10) = 0 then
counterstart = mypage - 9
else
counterstart = mypage - (mypage mod 10) + 1
end if
counterend = counterstart + 9
if counterend > maxpages then counterend = maxpages
if counterstart <> 1 then
ref="First Page : "
Response.Write ref
ref="Previous 10 Pages "
Response.Write ref
end if
Response.Write "["
for counter=counterstart to counterend
If counter>=10 then
pad=""
end if
if cstr(counter) <> mypage then
ref="" & pad & counter & ""
else
ref="" & pad & counter & ""
end if
Response.Write ref
if counter <> counterend then Response.Write " "
next
Response.Write "]"
if counterend <> maxpages then
ref=" Next 10 Pages"
Response.Write ref
ref=" : Last Page"
DISPLAY ref
end if
Response.Write "
"
Response.Write " | "
Response.Write " "
Response.Write " "
End Sub
'======================================================================
Sub RecordBuilder(sql, DisplayFields, blnPager)
'======================================================================
Const adUseClient = 3
strSQL = sql
Set conn = Server.CreateObject("ADODB.Connection")
conn.open dbODBCName, dbODBCUsername, dbODBCPassword
arrDisplayFields = Split(DisplayFields, ",")
' see if we're paging records
' request the various values if they're needed
If blnPager = True Then
mypage=Request("whichpage")
If mypage="" then
mypage=1
end if
mypagesize=Request("pagesize")
If mypagesize="" then
mypagesize=10
end if
if strSQL = "" then
strSQL = Request("SQLquery")
End If
Set rs = Server.CreateObject("ADODB.Recordset")
rs.cursorlocation=adUseClient
rs.cachesize=5
rs.open strSql, conn
ttlRecords = rs.RecordCount
If ttlRecords > 0 Then
rs.movefirst
rs.pagesize=mypagesize
howmanyfields=rs.fields.count -1
maxpages=cint(rs.pagecount)
maxrecs=cint(rs.pagesize)
rs.absolutepage=mypage
howmanyrecs=0
Response.Write ""
Response.Write ""
Response.Write ""
Response.Write "Page " & mypage & " of " & maxpages & "
"
Response.Write " | "
Response.Write " "
Response.Write " "
Response.Write ""
Response.Write ""
Response.Write " "
' Now make the page _ of _ hyperlinks
If blnPager = True then
PageNavBar strSQL, mypage, mypagesize, maxpages
End If
Else
displayMessage "There is no data to check.", "", ""
End If
End If
' close, destroy
rs.close
set rs = nothing
end sub
'======================================================================
Function displayNewUsers()
' shows all users awaiting approval
'======================================================================
Call adminHeader()
Response.Write "Approve New Users "
thesql = "SELECT * FROM [" & dbUsersTableName & "] WHERE Allow = 0 ORDER BY Name, Email"
RecordBuilder thesql, "ID,Name,Email", True
End Function
'======================================================================
Function displayNewAdministrator()
' shows all users awaiting approval
'======================================================================
Call adminHeader()
Response.Write "Approve New Administrators "
thesql = "SELECT * FROM [" & dbUsersTableName & "] WHERE Allow = 1 AND IsAdministrator = 0 ORDER BY Name, Email"
RecordBuilder thesql, "ID,Name,Email", True
End Function
'======================================================================
Function displayExistingUsers()
' shows all users that have been approved
'======================================================================
Call adminHeader()
Response.Write "Disable Existing Users "
thesql = "SELECT * FROM [" & dbUsersTableName & "] WHERE Allow = 1 ORDER BY Name, Email"
RecordBuilder thesql, "ID,Name,Email", True
End Function
'======================================================================
Function displayExistingAdministrator()
' shows all users that have been approved
'======================================================================
Call adminHeader()
Response.Write "Disable Existing Administrators "
thesql = "SELECT * FROM [" & dbUsersTableName & "] WHERE Allow = 1 AND IsAdministrator = 1 ORDER BY Name, Email"
RecordBuilder thesql, "ID,Name,Email", True
End Function
'======================================================================
Function displayNewNews()
' shows news awaiting approval
'======================================================================
Call adminHeader()
Response.Write "Approve New News "
thesql = "SELECT * FROM [" & dbTableName & "] WHERE Allow = 0 ORDER BY Date, Headline"
RecordBuilder thesql, "ID,Date,Headline", True
End Function
'======================================================================
Function displayExistingNews()
' shows approved news
'======================================================================
Call adminHeader()
Response.Write "Disable Existing News "
thesql = "SELECT * FROM [" & dbTableName & "] WHERE Allow = 1 ORDER BY Date, Headline"
RecordBuilder thesql, "ID,Date,Headline", True
End Function
'======================================================================
Function adminAddUser()
'======================================================================
Call adminHeader()
newsSubmit = Request("newsSubmit")
newsCheckForm = False
If newsSubmit = "Cancel" Then
Response.Redirect (constMyName & "?newsAction=newsAdministrator")
End If
If newsSubmit = "Register" Then
newsName = Request("newsName")
newsEmail = Request("newsEmail")
newsPassword = Request("newsPassword")
newsIsAdministrator = Request("newsIsAdministrator")
If (newsName <> "") And (newsEmail <> "") And (newsPassword <> "") Then
sql = "SELECT * FROM [" & dbUsersTablename & "] WHERE Email = '" & newsEmail & "'"
Set conn = Server.CreateObject("ADODB.Connection")
Set rs = Server.CreateObject("ADODB.RecordSet")
conn.open dbODBCName, dbODBCUsername, dbODBCPassword
rs.Open sql, conn, 3, 3
If rs.RecordCount > 0 Then
newsCheckForm = False
Else
newsCheckForm = True
End If
rs.Close
Set rs = Nothing
conn.close
Set conn = Nothing
Else
newsCheckForm = False
End If
If newsCheckForm <> False Then
sql = "[" & dbUsersTablename & "]"
Set conn = Server.CreateObject("ADODB.Connection")
Set rs = Server.CreateObject("ADODB.RecordSet")
conn.open dbODBCName, dbODBCUsername, dbODBCPassword
rs.Open sql, conn, 1, 2
rs.AddNew
rs("Name") = newsName
rs("Email") = newsEmail
rs("Password") = newsPassword
rs("IsAdministrator") = CBool(newsIsAdministrator)
rs("Allow") = True
rs.Update
rs.Close
Set rs = nothing
conn.close
Set conn = nothing
displayMessage "Your have successfully registered this user. They will be able to login immediately.", "", ""
Else
Response.Write "" & vbCrLf
End If
End If
If newsCheckForm = False Then
Response.Write ""
Response.Write ""
Response.Write "| "
Response.Write " Register "
Response.Write "Back to Current News"
Response.Write ""
Response.Write " | "
Response.Write " "
Response.Write " "
End If
End Function
'======================================================================
Function execNewUsers()
'======================================================================
Call securityAdmin()
thesql = "SELECT * FROM [" & dbUsersTableName & "] WHERE Allow = 0 ORDER BY Name, Email"
Set conn = Server.CreateObject("ADODB.Connection")
conn.open dbODBCName, dbODBCUsername, dbODBCPassword
Set rs = Server.CreateObject("ADODB.RecordSet")
rs.open thesql, conn, 1, 4
ttlUnapproved = Request("total")
rs.MoveFirst
blnUpdate = False
For i = 0 To ttlUnapproved
thisRow = Request("approve" & i)
If thisRow <> "" Then
thisID = Request("userID" & i)
While Not rs.Eof
If CStr(rs("ID")) = CStr(thisID) Then
blnUpdate = True
rs("Allow") = True
End If
rs.MoveNext
Wend
End If
rs.MoveFirst
Next
If blnUpdate = True Then
rs.UpdateBatch
End If
rs.Close
Set rs = Nothing
conn.close
Set conn = Nothing
If blnUpdate = True Then
Response.Write "
"
Response.Write "" & vbCrLf
Response.Write ""
Call displayNewUsers()
Else
Response.Write "" & vbCrLf
Call displayNewUsers()
End If
End Function
'======================================================================
Function execExistingUsers()
'======================================================================
Call securityAdmin()
thesql = "SELECT * FROM [" & dbUsersTableName & "] WHERE Allow = 1 ORDER BY Name, Email"
Set conn = Server.CreateObject("ADODB.Connection")
conn.open dbODBCName, dbODBCUsername, dbODBCPassword
Set rs = Server.CreateObject("ADODB.RecordSet")
rs.open thesql, conn, 1, 4
ttlUnapproved = Request("total")
rs.MoveFirst
blnUpdate = False
For i = 0 To ttlUnapproved
thisRow = Request("approve" & i)
If thisRow <> "" Then
thisID = Request("userID" & i)
While Not rs.Eof
If CStr(rs("ID")) = CStr(thisID) Then
blnUpdate = True
rs("Allow") = False
End If
rs.MoveNext
Wend
End If
rs.MoveFirst
Next
If blnUpdate = True Then
rs.UpdateBatch
End If
rs.Close
Set rs = Nothing
conn.close
Set conn = Nothing
If blnUpdate = True Then
Response.Write "
"
Response.Write "" & vbCrLf
Response.Write ""
Call displayExistingUsers()
Else
Response.Write "" & vbCrLf
Call displayExistingUsers()
End If
End Function
'======================================================================
Function execNewAdministrator()
'======================================================================
Call securityAdmin()
thesql = "SELECT * FROM [" & dbUsersTableName & "] WHERE Allow = 1 AND IsAdministrator = 0 ORDER BY Name, Email"
Set conn = Server.CreateObject("ADODB.Connection")
conn.open dbODBCName, dbODBCUsername, dbODBCPassword
Set rs = Server.CreateObject("ADODB.RecordSet")
rs.open thesql, conn, 1, 4
ttlUnapproved = Request("total")
rs.MoveFirst
blnUpdate = False
For i = 0 To ttlUnapproved
thisRow = Request("approve" & i)
If thisRow <> "" Then
thisID = Request("userID" & i)
While Not rs.Eof
If CStr(rs("ID")) = CStr(thisID) Then
blnUpdate = True
rs("IsAdministrator") = True
End If
rs.MoveNext
Wend
End If
rs.MoveFirst
Next
If blnUpdate = True Then
rs.UpdateBatch
End If
rs.Close
Set rs = Nothing
conn.close
Set conn = Nothing
If blnUpdate = True Then
Response.Write "
"
Response.Write "" & vbCrLf
Response.Write ""
Call displayNewAdministrator()
Else
Response.Write "" & vbCrLf
Call displayNewAdministrator()
End If
End Function
'======================================================================
Function execExistingAdministrator()
'======================================================================
Call securityAdmin()
thesql = "SELECT * FROM [" & dbUsersTableName & "] WHERE Allow = 1 AND IsAdministrator = 1 ORDER BY Name, Email"
Set conn = Server.CreateObject("ADODB.Connection")
conn.open dbODBCName, dbODBCUsername, dbODBCPassword
Set rs = Server.CreateObject("ADODB.RecordSet")
rs.open thesql, conn, 1, 4
ttlUnapproved = Request("total")
rs.MoveFirst
blnUpdate = False
For i = 0 To ttlUnapproved
thisRow = Request("approve" & i)
If thisRow <> "" Then
thisID = Request("userID" & i)
While Not rs.Eof
If CStr(rs("ID")) = CStr(thisID) Then
blnUpdate = True
rs("IsAdministrator") = False
End If
rs.MoveNext
Wend
End If
rs.MoveFirst
Next
If blnUpdate = True Then
rs.UpdateBatch
End If
rs.Close
Set rs = Nothing
conn.close
Set conn = Nothing
If blnUpdate = True Then
Response.Write "
"
Response.Write "" & vbCrLf
Response.Write ""
Call displayExistingAdministrator()
Else
Response.Write "" & vbCrLf
Call displayExistingAdministrator()
End If
End Function
'======================================================================
Function execNewNews()
'======================================================================
Call securityAdmin()
thesql = "SELECT * FROM [" & dbTableName & "] WHERE Allow = 0 ORDER BY Date, Headline"
Set conn = Server.CreateObject("ADODB.Connection")
conn.open dbODBCName, dbODBCUsername, dbODBCPassword
Set rs = Server.CreateObject("ADODB.RecordSet")
rs.open thesql, conn, 1, 4
ttlUnapproved = Request("total")
rs.MoveFirst
blnUpdate = False
For i = 0 To ttlUnapproved
thisRow = Request("approve" & i)
If thisRow <> "" Then
thisID = Request("userID" & i)
While Not rs.Eof
If CStr(rs("ID")) = CStr(thisID) Then
blnUpdate = True
rs("Allow") = True
End If
rs.MoveNext
Wend
End If
rs.MoveFirst
Next
If blnUpdate = True Then
rs.UpdateBatch
End If
rs.Close
Set rs = Nothing
conn.close
Set conn = Nothing
If blnUpdate = True Then
Response.Write "
"
Response.Write "" & vbCrLf
Response.Write ""
Call displayNewNews()
Else
Response.Write "" & vbCrLf
Call displayNewNews()
End If
'======================================================================
End Function
'======================================================================
'======================================================================
Function execExistingNews()
'======================================================================
Call securityAdmin()
thesql = "SELECT * FROM [" & dbTableName & "] WHERE Allow = 1 ORDER BY Date, Headline"
Set conn = Server.CreateObject("ADODB.Connection")
conn.open dbODBCName, dbODBCUsername, dbODBCPassword
Set rs = Server.CreateObject("ADODB.RecordSet")
rs.open thesql, conn, 1, 4
ttlUnapproved = Request("total")
rs.MoveFirst
blnUpdate = False
For i = 0 To ttlUnapproved
thisRow = Request("approve" & i)
If thisRow <> "" Then
thisID = Request("userID" & i)
While Not rs.Eof
If CStr(rs("ID")) = CStr(thisID) Then
blnUpdate = True
rs("Allow") = False
End If
rs.MoveNext
Wend
End If
rs.MoveFirst
Next
If blnUpdate = True Then
rs.UpdateBatch
End If
rs.Close
Set rs = Nothing
conn.close
Set conn = Nothing
If blnUpdate = True Then
Response.Write "
"
Response.Write "" & vbCrLf
Response.Write ""
Call displayExistingNews()
Else
Response.Write "" & vbCrLf
Call displayExistingNews()
End If
End Function
'======================================================================
' CORE CODE
'======================================================================
strMyOwnPath = Request.Servervariables("PATH_INFO")
intStart = InstrRev(strMyOwnPath,"/",-1,1)
strMyName = Mid(strMyOwnPath,intStart+1)
constMyName = strMyName
newsID = Request("newsID")
newsAction = Request("newsAction")
If imgDirectory = "" Then
imgDirectory = "UploadedImages"
End If
Select Case newsAction
Case ""
Call displayNews()
Case "newsArchives"
Call displayNewsArchives()
Case "newsArchivesSpecific"
Call displaySpecificNewsArchives()
Case "newsAddNews"
blnEditThisNews = False
Call displayEditingNews()
Case "newsLogin"
Call execLogin()
Case "newsLogout"
Call execLogout()
Case "newsEdit"
blnEditThisNews = True
Call displayEditingNews()
Case "newsDelete"
Response.Write ""
Response.Write ""
Response.Write "| "
Response.Write " Delete News "
Response.Write "Back to Current News"
Response.Write " | "
Response.Write ""
If Session("UserID") = "" Then
Call displayLogin()
Else
Response.Write "[Logout]"
End If
Response.Write " | "
Response.Write " "
Response.Write " "
If Request("newsConfirm") = "Yes" Then
Call execDelNews()
displayMessage "News Entry Deleted.", "", ""
Else
If Request("newsConfirm") = "No" Then
displayMessage "Operation Aborted.", "", ""
Else
Call execSecurity()
displayMessage "Are you sure? ( Yes / No )", "", ""
End If
End If
Case "newsRegister"
Call newsRegister()
Case "newsForgotten"
Call newsForgotten()
Case "newsEmailFriend"
Call newsEmailFriend()
Case "newsSearch"
Call displaySearch()
Case "newsAdministrator"
Call adminMain()
Case "adminNewUsers"
Call displayNewUsers()
Case "adminNewAdministrator"
Call displayNewAdministrator()
Case "adminExistingUsers"
Call displayExistingUsers()
Case "execExistingUsers"
Call execExistingUsers()
Case "adminExistingAdministrator"
Call displayExistingAdministrator()
Case "adminNewNews"
Call displayNewNews()
Case "adminExistingNews"
Call displayExistingNews()
Case "execNewUsers"
Call execNewUsers()
Case "execNewAdministrator"
Call execNewAdministrator()
Case "execExistingAdministrator"
Call execExistingAdministrator()
Case "execNewUsers"
Call execNewUsers()
Case "execNewNews"
Call execNewNews()
Case "execExistingNews"
Call execExistingNews()
Case "adminNews"
Call adminNews()
Case "adminEdit"
Call adminEdit()
Case "adminDelete"
Call securityAdmin()
If Request("newsConfirm") = "Yes" Then
Call execAdminDelNews()
Response.Write "" & vbCrLf
Else
If Request("newsConfirm") = "No" Then
Response.Redirect(constMyName & "?newsAction=adminNews&newsID=" & newsID)
Else
displayMessage "Are you sure? ( Yes / No )", "", ""
End If
End If
Case "adminAddUser"
Call adminAddUser()
Case "newsEditProfile"
blnEditProfile = True
Call newsRegister()
End Select
%>
Disclaimer
Grocane accepts no liability of whatsoever nature for any loss, liability,
damage or expense resulting directly or indirectly from the use of any information on this website.
| | | | |
| | | |
|
