<% '**************************************************************************** '* XcNews - (C)Copyright 1998-2000 - XCENT - www.xcent.com * '**************************************************************************** '* Version 1.6 '* '* To setup XcNews for your site, modify the XcNewsConfig.asp file '* Dim gsRootURL Dim gobjConn Dim gsConnect Dim grs Dim gsSQL Dim gsCommand Dim gsPageHeader Dim gsPageFooter Dim gsAdminPassword Dim giAdmiFlag Dim gsLoginName Dim gsLoginPassword Dim gsEmbeddedCode Response.Buffer = True giAdminFlag = False gsLoginName = Trim(Request.Cookies("XcNews")("Login")) gsLoginPassword = Trim(Request.Cookies("XcNews")("Password")) If gsLoginPassword = gsAdminPassword Then giAdminFlag = True End If gsRootURL = "http://" & Request.ServerVariables("SERVER_NAME") & Request.ServerVariables("SCRIPT_NAME") gsCommand = UCase(Trim(Request.QueryString("CMD"))) If Len(Trim(gsCommand)) = 0 Then gsCommand = sDefaultAction End If Select Case gsCommand Case "FIND": FindArticle Case "VIEW": ViewArticle Case "EDIT": EditArticle Case "DELETE": DeleteArticle Case "ADMIN": DoAdminMenu Case "DETAIL": DetailListArticles Case "LIST": ListArticles Case "SHOWTOP": ShowTop Case Else ShowTop End Select DoPageFooter Sub ShowTop Dim sTemp Dim sPageTop Dim dLastArticleActive Dim sShowDate gsSQL = "SELECT * FROM Articles WHERE ArticleActive <= " & SQLDate(Now) & " AND (ArticleExpires >= " & SQLDate(Now) & " OR ArticleExpires Is Null) ORDER BY ArticleActive DESC, ArticleName" DoPageHeader OpenDBConn Set grs = gobjConn.Execute(gsSQL) If grs.EOF Then 'No records Response.Write("No articles are listed.") Else 'List Items Response.Write("") Response.Write("" & grs.Fields("ArticleName") & "
") Response.Write("") Response.Write("Date: " & grs.Fields("ArticleActive") & "
") If Instr("" & grs.Fields("ArticleAuthor"), "@") <> 0 Then Response.Write("Written By: " & grs.Fields("ArticleAuthor") & "

") Else Response.Write("Written By: " & grs.Fields("ArticleAuthor") & "

") End If Response.Write("") If giAdminFlag Then Response.Write("

") Response.Write("") Response.Write("") Response.Write("
EditDelete

") End If Response.Write("" & grs.Fields("ArticleData") & "

") grs.MoveNext If Not grs.EOF Then Response.Write("

Previous Articles
") End If Do While Not grs.EOF If dLastArticleActive = grs.Fields("ArticleActive") Then sShowDate = "" Else dLastArticleActive = grs.Fields("ArticleActive") sShowDate = FormatDateTime(dLastArticleActive, 2) End If sTemp = "" If giAdminFlag Then sTemp = sTemp & "" & sShowDate & "" sTemp = sTemp & "Edit  " sTemp = sTemp & "Delete" Else sTemp = sTemp & "" & sShowDate & "" End If sTemp = sTemp & "" sTemp = sTemp & grs.Fields("ArticleName") & "" sTemp = sTemp & "" Response.Write(sTemp) grs.MoveNext Loop Response.Write("") End If grs.Close Set grs = Nothing CloseDBConn End Sub Sub DoAdminMenu Dim sLoginName Dim sPassword If giAdminFlag Then 'Show Admin Menu DoPageHeader Response.Write("Administrative Menu
") Response.Write("Login Name: " & gsLoginName & "

") Response.Write("List of ALL Articles
") Response.Write("List of EXPIRED Articles
") Response.Write("List of UPCOMING Articles
") Response.Write("

") Response.Write("Detail List of ALL Articles
") Response.Write("Detail List of EXPIRED Articles
") Response.Write("Detail List of UPCOMING Articles
") Response.Write("
") Response.Write("Add new Article
") Else 'Do Admin Login sLoginName = Trim(Request.Form("LoginName")) sPassword = Trim(Request.Form("Password")) If Len(sLoginName) = 0 Then 'Present user with form DoPageHeader Response.Write("
") Response.Write("To perform any administrative functions, you must be logged ") Response.Write("in first. Type in your email address for the login name.

") Response.Write("Login Name:
") Response.Write("Password:
") Response.Write("

") Else 'Process form If sPassword = gsAdminPassword Then Response.Cookies("XcNews")("Login") = sLoginName Response.Cookies("XcNews")("Password") = sPassword Response.Write("") DoPageHeader Response.Write("Persmission Granted
") Response.Write("Click here to continue") Else Response.Write("") DoPageHeader Response.Write( "Persmission Denied
" ) Response.Write("Click here to continue") End If End If End If End Sub Sub EditArticle Dim sArticleID Dim sArticleName Dim sArticleAuthor Dim dArticleActive Dim dArticleExpires Dim sArticleData If Not giAdminFlag Then InsufficientLogin Exit Sub End If Select Case UCase(Request.Form("UPDATE")) Case "UPDATE": OpenDBConn sArticleID = Request.Form("ARTICLEID") sArticleName = Request.Form("ARTICLENAME") sArticleName = Replace(sArticleName, "'", "''") sArticleAuthor = Request.Form("ARTICLEAUTHOR") sArticleAuthor = Replace(sArticleAuthor, "'", "''") dArticleActive = Request.Form("ARTICLEACTIVE") If Not IsDate(dArticleActive) Then dArticleActive = Now End If dArticleExpires = Request.Form("ARTICLEEXPIRES") If Not IsDate(dArticleExpires) Then dArticleExpires = Null End If sArticleData = Request.Form("ARTICLEDATA") sArticleData = Replace(sArticleData, "'", "''") If Len(Trim(sArticleID)) > 0 Then 'Update gsSQL = "UPDATE Articles SET " & _ "ArticleName = " & SQLStr(sArticleName) & ", " & _ "ArticleAuthor = " & SQLStr(sArticleAuthor) & ", " & _ "ArticleActive = " & SQLDate(dArticleActive) & ", " & _ "ArticleExpires = " & SQLDate(dArticleExpires) & ", " & _ "ArticleData = " & SQLStr(sArticleData) & " " & _ " WHERE ArticleID = " & SQLVal(sArticleID) Else 'Insert gsSQL = "INSERT INTO Articles (ArticleName, ArticleAuthor, ArticleActive, ArticleExpires, ArticleData) VALUES (" & _ SQLStr(sArticleName) & ", " & _ SQLStr(sArticleAuthor) & ", " & _ SQLDate( dArticleActive) & ", " & _ SQLDate( dArticleExpires) & ", " & _ SQLStr(sArticleData) & " " & _ ") " End If gobjConn.Execute(gsSQL) DoPageHeader If Len(Trim(sArticleID)) > 0 Then Response.Write("Updated
") Else Response.Write("Added
") End If Response.Write("") CloseDBConn Case Else sArticleID = Trim(Request.QueryString("ARTICLEID")) If Len(sArticleID) > 0 Then 'Get existing date gsSQL = "SELECT * FROM Articles WHERE ArticleID = " & SQLVal(sArticleID) OpenDBConn Set grs = gobjConn.Execute(gsSQL) If Not grs.Eof Then sArticleName = "" & grs.Fields("ArticleName") sArticleAuthor = "" & grs.Fields("ArticleAuthor") dArticleActive = grs.Fields("ArticleActive") dArticleExpires = grs.Fields("ArticleExpires") sArticleData = "" & grs.Fields("ArticleData") End If grs.Close Set grs = Nothing CloseDBConn Else 'New record sArticleID = "" sArticleName = "" sArticleAuthor = gsLoginName dArticleActive = Now dArticleExpires = Null sArticleData = "" End If DoPageHeader Response.Write("") Response.Write("") Response.Write("") If Len(sArticleID) > 0 Then Response.Write("Edit Article
") Response.Write("This is where you can modify an article that already exists. You should ") Response.Write("only modify articles to make corrections.") Else Response.Write("Add Article
") Response.Write("This is where you create a new article. Every article must contain at least ") Response.Write("the Article Name, the Article Active, and the ") Response.Write("Article Data fields.") End If Response.Write("

") Response.Write("") Response.Write("") Response.Write("") Response.Write("") Response.Write("") Response.Write("
Article Name:
") Response.Write("The descriptive name of the article. This is how the article appears in lists.
Author:
") Response.Write("This should be your Email address, or full name if you do not have one.
Active:
") Response.Write("This is the date the article should be published, or made available.
Expires:
") Response.Write("This is the date the article should no longer be available, or considered current. Leave this blank if it should always remain visible in article lists.
Article:
") Response.Write("This is where you type the article text. You may include HTML formatting tags.
") Response.Write("") End Select End Sub Sub DeleteArticle Dim sArticleID If giAdminFlag Then sArticleID = Trim(Request.QueryString("ARTICLEID")) If Len(sArticleID) = 0 Then sArticleID = Trim(Request.Form("ARTICLEID")) End IF If Len(sArticleID) = 0 Then DoPageHeader Response.Write("An ArticleID must be specified.") Response.Write("") Else Select Case UCase(Request.Form("ACTION")) Case "DELETE": gsSQL = "DELETE FROM Articles WHERE ArticleID = " & SQLVal(sArticleID) OpenDBConn gobjConn.Execute(gsSQL) CloseDBConn DoPageHeader Response.Write("") Response.Write("Article was deleted.") Case "NOT": DoPageHeader Response.Write("") Response.Write("Not deleted.") Case Else DoPageHeader Response.Write("Delete
") Response.Write("Are you absolutely sure you want to delete ArticleID:" & sArticleID & "?
") Response.Write("There is no way to get it back once you do this.") Response.Write("") Response.Write("") Response.Write("No, I changed my mind.
") Response.Write("Yes, delete it forever.
") Response.Write("") End Select End If Else InsufficientLogin End If End Sub Sub InsufficientLogin DoPageHeader Response.Write("Attention
") Response.Write("You do not have rights for that operation.") Response.Write("") End Sub Sub FindArticle 'SELECT * FROM Articles WHERE ArticleData Like "*Future*" or ArticleData Like "*always*" End Sub Sub ListArticles Dim sTemp Dim sPageTop Dim dLastArticleActive Dim sShowDate Select Case UCase(Request.QueryString("TYPE")) Case "ALL": sPageTop = "List ALL Articles
" gsSQL = "SELECT * FROM Articles ORDER BY ArticleActive DESC, ArticleName" Case "EXPIRED": sPageTop = "List Expired Articles
" gsSQL = "SELECT * FROM Articles WHERE ArticleExpires <= " & SQLDate(Now ) & " ORDER BY ArticleActive DESC, ArticleName" Case "UPCOMING": sPageTop = "List Upcoming Articles
" gsSQL = "SELECT * FROM Articles WHERE ArticleActive > " & SQLDate(Now ) & " ORDER BY ArticleActive DESC, ArticleName" Case Else sPageTop = "List of Current Articles
" gsSQL = "SELECT * FROM Articles WHERE ArticleActive <= " & SQLDate(Now) & " AND (ArticleExpires >= " & SQLDate(Now) & " OR ArticleExpires Is Null) ORDER BY ArticleActive DESC, ArticleName" End Select DoPageHeader Response.Write(sPageTop) OpenDBConn Set grs = gobjConn.Execute(gsSQL) If grs.EOF Then 'No records Response.Write("No articles are listed.") Else 'List Items Response.Write("") Do While Not grs.EOF If dLastArticleActive = grs.Fields("ArticleActive") Then sShowDate = "" Else dLastArticleActive = grs.Fields("ArticleActive") sShowDate = FormatDateTime(dLastArticleActive, 2) End If sTemp = "" If giAdminFlag Then sTemp = sTemp & "" Else sTemp = sTemp & "" End If sTemp = sTemp & "" sTemp = sTemp & "" Response.Write(sTemp) grs.MoveNext Loop Response.Write("
" & sShowDate & "" sTemp = sTemp & "Edit  " sTemp = sTemp & "Delete" & sShowDate & "" sTemp = sTemp & grs.Fields("ArticleName") & "
") End If grs.Close Set grs = Nothing CloseDBConn End Sub Sub DetailListArticles Dim sTemp Dim sPageTop Dim dLastArticleActive Dim sShowDate Select Case UCase(Request.QueryString("TYPE")) Case "ALL": sPageTop = "List ALL Articles
" gsSQL = "SELECT * FROM Articles ORDER BY ArticleActive DESC, ArticleName" Case "EXPIRED": sPageTop = "List Expired Articles
" gsSQL = "SELECT * FROM Articles WHERE ArticleExpires <= " & SQLDate(Now ) & " ORDER BY ArticleActive DESC, ArticleName" Case "UPCOMING": sPageTop = "List Upcoming Articles
" gsSQL = "SELECT * FROM Articles WHERE ArticleActive > " & SQLDate(Now ) & " ORDER BY ArticleActive DESC, ArticleName" Case Else sPageTop = "List of Current Articles
" gsSQL = "SELECT * FROM Articles WHERE ArticleActive <= " & SQLDate(Now) & " AND (ArticleExpires >= " & SQLDate(Now) & " OR ArticleExpires Is Null) ORDER BY ArticleActive DESC, ArticleName" End Select DoPageHeader Response.Write(sPageTop) OpenDBConn Set grs = gobjConn.Execute(gsSQL) If grs.EOF Then 'No records Response.Write("No articles are listed.") Else 'List Items Response.Write("") Do While Not grs.EOF If dLastArticleActive = grs.Fields("ArticleActive") Then sShowDate = "" Else dLastArticleActive = grs.Fields("ArticleActive") sShowDate = "" & FormatDateTime(dLastArticleActive, 2) & "" End If sTemp = "" If giAdminFlag Then sTemp = sTemp & "" Else sTemp = sTemp & "" End If sTemp = sTemp & "" sTemp = sTemp & "" Response.Write(sTemp) sTemp = "" Response.Write(sTemp) grs.MoveNext Loop Response.Write("
" & sShowDate & "" sTemp = sTemp & "Edit  " sTemp = sTemp & "Delete" & sShowDate & "" sTemp = sTemp & "" & grs.Fields("ArticleName") & "
" & grs.Fields("ArticleData") & "

 

") End If grs.Close Set grs = Nothing CloseDBConn End Sub Sub ViewArticle Dim sArticleID sArticleID = Trim(Request.QueryString("ARTICLEID")) If Len(sArticleID) > 0 Then gsSQL = "SELECT * FROM Articles WHERE ArticleID = " & SQLVal(sArticleID) OpenDBConn Set grs = gobjConn.Execute(gsSQL) If grs.EOF Then 'No such article Response.Write("No such article on file.") Else DoPageHeader Response.Write("" & grs.Fields("ArticleName") & "
") Response.Write("") Response.Write("ArticleID: " & grs.Fields("ArticleID") & "
") Response.Write("Date: " & grs.Fields("ArticleActive") & "
") If Instr("" & grs.Fields("ArticleAuthor"), "@") <> 0 Then Response.Write("Written By: " & grs.Fields("ArticleAuthor") & "

") Else Response.Write("Written By: " & grs.Fields("ArticleAuthor") & "

") End If Response.Write("") If giAdminFlag Then Response.Write("") Response.Write("") Response.Write("") Response.Write("
EditDelete

") End If Response.Write("" & grs.Fields("ArticleData") & "

") End If grs.Close Set grs = Nothing CloseDBConn Else Response.Write("An ArticleID number must be supplied.") End If End Sub Function SQLStr(pvValue) Dim sTemp Select Case VarType(pvValue) Case 0, 1: SQLStr = "NULL" Case 2, 3, 4, 5, 6: sTemp = "" & pvValue sTemp = Replace(sTemp, "'", "''") SQLStr = "'" & sTemp & "'" Case 7: 'DateTime sTemp = FormatDateTime(pvValue) sTemp = Replace(sTemp, "'", "''") SQLStr = "'" & sTemp & "'" Case 8: 'String sTemp = pvValue sTemp = Replace(sTemp, "'", "''") If Len(Trim(sTemp)) > 0 Then SQLStr = "'" & sTemp & "'" Else SQLStr = "NULL" End If Case Else SQLStr = "NULL" End Select End Function Function SQLBool(pvValue) Dim sTemp Select Case VarType(pvValue) Case 0, 1: SQLBool = "'N'" Case 2, 3, 4, 5, 6: If pvValue Then SQLBool = "'Y'" Else SQLBool = "'N'" End If Case 8: 'String sTemp = UCase(Left(Trim(pvValue), 1)) Select Case sTemp Case "Y", "T", "1", "-": SQLBool = "'Y'" Case "N", "F", "0", "": SQLBool = "'N'" Case Else SQLBool = "'N'" End Select Case 11: If pvValue Then SQLBool = "'Y'" Else SQLBool = "'N'" End If Case Else SQLBool = "'N'" End Select End Function Function SQLVal(pvValue) Dim sTemp Select Case VarType(pvValue) Case 0, 1: SQLVal = "NULL" Case 2, 3, 4, 5, 6: SQLVal = "" & pvValue Case 8: 'String sTemp = Trim(pvValue) On Error Resume Next SQLVal = "" & CDbl(sTemp) If Err.Number <> 0 Then Err.Clear SQLVal = "NULL" End If Case 11: SQLVal = "" & Cint(pvValue) Case Else SQLVal = "NULL" End Select End Function Function SQLDate(pvDate) Select Case VarType(pvDate) Case 7: 'Date If giSQLDateAsSystem Then SQLDate = gsSQLDateDelimiter & FormatDateTime(pvDate,2) & " " & FormatDateTime(pvDate,4) & gsSQLDateDelimiter Else SQLDate = gsSQLDateDelimiter & NumToStrLeadDigits(Year(pvDate),4) & NumToStrLeadDigits(Month(pvDate),2) & NumToStrLeadDigits(Day(pvDate),2) & " " & FormatDateTime(pvDate,4) & gsSQLDateDelimiter End If Case 8: 'String If IsDate(pvDate) Then If giSQLDateAsSystem Then SQLDate = gsSQLDateDelimiter & FormatDateTime(CDate(pvDate),2) & " " & FormatDateTime(CDate(pvDate),4) & gsSQLDateDelimiter Else SQLDate = gsSQLDateDelimiter & NumToStrLeadDigits(Year(CDate(pvDate)),4) & NumToStrLeadDigits(Month(CDate(pvDate)),2) & NumToStrLeadDigits(Day(CDate(pvDate)),2) & " " & FormatDateTime(CDate(pvDate),4) & gsSQLDateDelimiter End If Else SQLDate = "NULL" End If Case Else SQLDate = "NULL" End Select End Function Sub DoPageFooter If Len(Trim(gsPageFooter)) > 0 Then Response.Write(gsPageFooter) End If End Sub Sub DoPageHeader Dim sPrePageFooter Dim lEmbeddedAt gsPageFooter = "

" & Chr(68) & Chr(114) & Chr(105) & Chr(118) & Chr(101) & _ Chr(110) & " " & Chr(98) & Chr(121) & " " & Chr(60) & Chr(65) & " H" & Chr(82) & "E" & Chr(70) & _ Chr(61) & Chr(34) & Chr(104) & Chr(116) & Chr(116) & Chr(112) & Chr(58) & Chr(47) & _ Chr(47) & Chr(119) & Chr(119) & Chr(119) & Chr(46) & Chr(120) & Chr(99) & _ Chr(101) & Chr(110) & Chr(116) & Chr(46) & Chr(99) & Chr(111) & Chr(109) & Chr(34) & " " & _ Chr(116) & "arg" & "et=" & Chr(34) & "res" & Chr(111) & "ur" & Chr(99) & "e" & Chr(32) & "window"">" & _ Chr(88) & Chr(99) & Chr(101) & Chr(110) & Chr(116) & "" sPrePageFooter = gsPageFooter sTemp = "" If Len(Trim(gsPageHeader)) > 0 Then On Error Resume Next Set fs = CreateObject("Scripting.FileSystemObject") Set ts = fs.OpenTextFile(gsPageHeader) sTemp = ts.ReadAll ts.Close Set ts = Nothing Set fs = Nothing On Error Goto 0 End If If Len(Trim(sTemp)) = 0 Then sTemp = "XcNews System" End If lEmbeddedAt = Instr(1, sTemp, gsEmbeddedCode, 1) If lEmbeddedAt > 0 Then gsPageFooter = sPrePageFooter & Right(sTemp, Len(sTemp) - lEmbeddedAt - Len(gsEmbeddedCode) + 1) sTemp = Left(sTemp, lEmbeddedAt - 1) End If Response.Write(sTemp) End Sub Sub OpenDBConn Set gobjConn = Server.CreateObject("ADODB.Connection") gobjConn.Open gsConnect End Sub Sub CloseDBConn gobjConn.Close Set gobjConn = Nothing End Sub %>