<%
'==============================
'forum functions - sept 12 2000
'==============================
'============
'grabbing the ip of the user, not great,
'but pretty close most of the time
'============
function ip_dig
if Request.ServerVariables("HTTP_X_FORWARDED_FOR") <> "" then
ip_dig = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
else
ip_dig = Request.ServerVariables("REMOTE_ADDR")
end if
end function
'======================
'a simple login check function
function forum_login(byval login, pass)
set con = Server.CreateObject("ADODB.Connection")
con.Open(DSN)
'open the connection to the DSN (SQL server)
query = "SELECT id, user_name, active, email " & _
"FROM forum_user " & _
"WHERE (login = '"& SQLSafe(login) &"') AND (pass = '"& SQLSafe(pass) &"')"
'for a quick debug of the query
'Response.Write("query = [" & query & "]
")
set RS=con.Execute(query)
if not RS.eof then
'ALWAYS check of the EOF (end of file)
if RS("active") then
'cool, they are also active :]
Response.Cookies("lvl")("forumid") = RS("id")
Response.Cookies("lvl")("forumuser_name") = RS("user_name")
Response.Cookies("lvl").expires = dateadd("yyyy",1,now())
session("schk") = 0
if (Request.Form("returnto") <> "") and (not instr(7,Request.Form("returnto"),"logout.asp") > 7) then
Response.Redirect(Request.Form("returnto"))
else
Response.Redirect("./")
end if
else
'looks like they have a login and pass, but have not *unlocked* it as yet
error = true
error_msg = error_msg & "You need to unlock your login before you can do much else. An email would have been sent to " & RS("email") & " with infomation on how to activate your account."
end if
else
error = true
error_msg = error_msg & "The login and password combination was not found in the database, try again?"
end if
RS.Close
con.Close
end function
'================
'a simple logout
function forum_logout
Response.Cookies("lvl")("forumid") = ""
Response.Cookies("lvl")("forumuser_name") = ""
Response.Cookies("lvl").expires = dateadd("d",-1,now())
end function
function grab_titles(byval id_parent)
set con = Server.CreateObject("ADODB.Connection")
con.Open(DSN)
'open the connection to the DSN (SQL server)
query = "SELECT forum_msg.id as id, " & _
" forum_msg.id_parent as id_parent, " & _
" forum_msg.msg_title as msg_title, " & _
" forum_msg.datestamp as datestamp, " & _
" forum_msg.id_user as id_user, " & _
" forum_msg.who_posted as who_posted, " & _
" forum_user.user_name as user_name " & _
"FROM forum_msg (nolock) LEFT OUTER JOIN " & _
" forum_user ON " & _
" forum_msg.id_user = forum_user.id " & _
"WHERE "
if id_parent > 0 then
query = query & " forum_msg.id_parent = 0 " & _
"AND forum_msg.id = " & id_parent & " " & _
"AND forum_msg.censored = 0"
else
query = query & " forum_msg.id_parent = 0 " & _
"AND forum_msg.censored = 0 " & _
"Order by forum_msg.datestamp DESC"
end if
'for a quick debug of the query
'Response.Write("query = [" & query & "]
")
set RS=con.Execute(query)
if not RS.eof then
'ALWAYS check of the EOF (end of file)
'dump the entire query results into an array
category_titles = RS.getRows()
end if
RS.Close
con.Close
'close the SQL connection
if isarray(category_titles) then
'now do something with the data
'this is a little on the messy side, but not sure
'how else to do it
for i=0 to ubound(category_titles,2)
%>
| <%=server.HTMLEncode(category_titles(2,i))%> |
<%
if isnull(category_titles(6,i)) then
'ok, write something
Response.Write(category_titles(5,i))
else
'cool, a registered user!
Response.Write(category_titles(6,i))
end if
%> |
<%
if hours_from_now(category_titles(3,i)) < 25 then
Response.Write(hours_from_now(category_titles(3,i)) & " hrs")
else
Response.Write(days_from_now(category_titles(3,i)) & " days")
end if
%> |
<%=post_count(category_titles(0,i))%> |
<%
'NOW the messy bit - grab the most recent posts
'this is a call
if id_parent > 0 then
call topic_titles(category_titles(0,i),true)
else
call topic_titles(category_titles(0,i),false)
end if
if (ubound(category_titles,2)) or (ubound(category_titles,2) = 0) then
'displaying a *finishing line*, for some reason if ubound() = 0 then
'ubound() is displayed as *false* (kind of makes sense) so need to check
'for a ubound() = 0 as well as a ubound()
%>
 |
<%
end if
next
end if
end function
function post_count(byval parent_id)
set con = Server.CreateObject("ADODB.Connection")
con.Open(DSN)
'open the connection to the DSN (SQL server)
query = "SELECT COUNT(id) as count_post " & _
"FROM forum_msg (nolock) " & _
"WHERE id_parent = " & parent_id & " AND censored = 0"
'Response.Write("query = [" & query & "]
")
set RS=con.Execute(query)
if not RS.eof then
'ALWAYS check of the EOF (end of file)
'dump the entire query results into an array
post_count = RS("count_post")
else
post_count = "none"
end if
RS.Close
con.Close
end function
function topic_titles(byval parent_id, full_list)
dim category_topics, bgcolor
set con = Server.CreateObject("ADODB.Connection")
con.Open(DSN)
'open the connection to the DSN (SQL server)
if full_list then
query = "SELECT forum_msg.id AS id, " & _
" forum_msg.msg_title AS msg_title, " & _
" forum_msg.datestamp AS datestamp, " & _
" forum_user.user_name AS user_name, " & _
" forum_msg.who_posted AS who_posted " & _
"FROM forum_msg (nolock) LEFT OUTER JOIN " & _
" forum_user ON forum_msg.id_user = forum_user.id " & _
"WHERE (forum_msg.is_topic = 1) AND (forum_msg.id_parent = "& parent_id &") AND (forum_msg.censored = 0)" & _
"ORDER BY forum_msg.datestamp DESC"
else
query = "SELECT TOP 15 forum_msg.id AS id, " & _
" forum_msg.msg_title AS msg_title, " & _
" forum_msg.datestamp AS datestamp, " & _
" forum_user.user_name AS user_name, " & _
" forum_msg.who_posted AS who_posted " & _
"FROM forum_msg (nolock) LEFT OUTER JOIN " & _
" forum_user ON forum_msg.id_user = forum_user.id " & _
"WHERE (forum_msg.is_topic = 1) AND (forum_msg.id_parent = "& parent_id &") AND (forum_msg.censored = 0)" & _
"ORDER BY forum_msg.datestamp DESC"
end if
'for a quick debug of the query
'Response.Write("query = [" & query & "]
")
set RS=con.Execute(query)
if not RS.eof then
'ALWAYS check of the EOF (end of file)
'dump the entire query results into an array
category_topics = RS.getRows()
end if
RS.Close
con.Close
'close the SQL connection
if isarray(category_topics) then
'cool... now format them results
for n=0 to ubound(category_topics,2)
'lets have pretty bar colours too!
if n mod 2 = 0 then
bgcolor = " bgcolor=""" & bgcolourCustom & """"
else
bgcolor = ""
end if
if full_list then
'they want them all, so show them all!!
%>
| ><%=server.HTMLEncode(category_topics(1,n))%> |
><%
if (category_topics(4,n)) <> "anon" then
'ok, only registered users can make a topic, but they have
'used a different nick.... do we really want this flexiblilty?
Response.Write(category_topics(4,n))
else
'cool, a registered user!
Response.Write(category_topics(3,n))
end if
%> |
><%
if hours_from_now(category_topics(2,n)) < 25 then
Response.Write(hours_from_now(category_topics(2,n)) & " hrs")
else
Response.Write(days_from_now(category_topics(2,n)) & " days")
end if
%> |
><%=post_count(category_topics(0,n))%> |
<%
else
'don't want the full list, so cut them short at 14 posts
if n < 14 then
'only want the top 14, if there is more display a link where the user can *see* more for themself
%>
| ><%=server.HTMLEncode(category_topics(1,n))%> |
><%
if (category_topics(4,n)) <> "anon" then
'ok, only registered users can make a topic, but they have
'used a different nick.... do we really want this flexiblilty?
Response.Write(category_topics(4,n))
else
'cool, a registered user!
Response.Write(category_topics(3,n))
end if
%> |
><%
if hours_from_now(category_topics(2,n)) < 25 then
Response.Write(hours_from_now(category_topics(2,n)) & " hrs")
else
Response.Write(days_from_now(category_topics(2,n)) & " days")
end if
%> |
><%=post_count(category_topics(0,n))%> |
<%
else
'show a *see more* link
%>
| show more topics on this subject |
<%
end if
end if
'close the 14 post cut off
next
end if
end function
'grabs the post id and title of post
function forum_titles_list
set con = Server.CreateObject("ADODB.Connection")
con.Open(DSN)
'open the connection to the DSN (SQL server)
query = "SELECT top 31 id, msg_title " & _
"FROM forum_msg (nolock) " & _
"WHERE (is_category = 0) AND (is_topic = 1) and (censored = 0)" & _
"ORDER BY datestamp DESC"
'for a quick debug of the query
'Response.Write("query = [" & query & "]
")
set RS=con.Execute(query)
if not RS.eof then
'ALWAYS check of the EOF (end of file)
'dump the entire query results into an array
titles_list = RS.getRows()
end if
RS.Close
con.Close
end function
'=================
'msg_details grabs the title and authour of a topic based on the query string id
function msg_details(byval msg_id, censored)
set con = Server.CreateObject("ADODB.Connection")
con.Open(DSN)
'open the connection to the DSN (SQL server)
query = "SELECT " & _
" forum_user.user_name as user_name," & _
" forum_user.sig_file as sig_file," & _
" forum_user.reg_tag as reg_tag, " & _
" forum_msg.msg_title as msg_title, " & _
" forum_msg.datestamp as datestamp, " & _
" forum_msg.started_date as started_date, " & _
" forum_msg.who_posted as who_posted, " & _
" forum_msg.show_sig as show_sig, "
if not censored then
query = query & " forum_msg.censored as censored, "
query = query & " forum_msg.ip_user as ip_user, "
end if
query = query & " forum_msg.msg_body as msg_body " & _
"FROM forum_msg (nolock) LEFT OUTER JOIN " & _
" forum_user ON forum_msg.id_user = forum_user.id " & _
"WHERE forum_msg.id = " & SQLSafe(msg_id)
if censored then
query = query & " AND forum_msg.censored = 0"
end if
'for a quick debug of the query
'Response.Write("query = [" & query & "]
")
set RS=con.Execute(query)
if not RS.eof then
'ALWAYS check of the EOF (end of file)
'category_titles = RS.getRows()
msg_user_name = RS("user_name")
msg_sig_file = RS("sig_file")
msg_reg_tag = RS("reg_tag")
msg_title = RS("msg_title")
msg_datestamp = RS("datestamp")
msg_started_date = RS("started_date")
msg_who_posted = RS("who_posted")
msg_show_sig = RS("show_sig")
msg_msg_body = RS("msg_body")
if not censored then
msg_censored = RS("censored")
msg_ip_user = RS("ip_user")
end if
end if
RS.Close
con.Close
'close the SQL connection
end function
'=================
'msg_replies grabs the replies in an array
function msg_replies(byval msg_id)
set con = Server.CreateObject("ADODB.Connection")
con.Open(DSN)
'open the connection to the DSN (SQL server)
query = "SELECT forum_user.user_name AS user_name, " & _
" forum_user.sig_file AS sig_file, " & _
" forum_user.reg_tag AS reg_tag, " & _
" forum_msg.datestamp AS datestamp, " & _
" forum_msg.who_posted AS who_posted, " & _
" forum_msg.msg_body AS msg_body, " & _
" forum_msg.ip_user, " & _
" forum_msg.show_sig " & _
"FROM forum_msg (nolock) LEFT OUTER JOIN " & _
" forum_user ON " & _
" forum_msg.id_user = forum_user.id " & _
"WHERE (forum_msg.id_parent =" & SQLSafe(msg_id) & ") " & _
"AND forum_msg.censored = 0 " & _
"ORDER BY forum_msg.datestamp DESC"
'for a quick debug of the query
'Response.Write("query = [" & query & "]
")
set RS=con.Execute(query)
if not RS.eof then
'ALWAYS check of the EOF (end of file)
msg_replies_array = RS.getRows()
end if
RS.Close
con.Close
end function
'=================
'msg_check makes sure the request is for a real topic, not a reply
function msg_check(byval msgchk_id)
set con = Server.CreateObject("ADODB.Connection")
con.Open(DSN)
'open the connection to the DSN (SQL server)
query = "SELECT id from forum_msg (nolock) " & _
"where is_topic = 1 and id = " & SQLSafe(msgchk_id)
'for a quick debug of the query
'Response.Write("query = [" & query & "]
")
set RS=con.Execute(query)
if RS.eof then
error = true
error_msg = error_msg & "The topic you are trying view is not a real topic (its really a reply to a topic), sorry."
end if
con.close
end function
'====================
'insert the data submited, but checks it
'1st for banned users and un wanted html
'====================
function insert_post(byval id_parent)
dim txt_comment, posters_name, ip_user
'trim and make sure the text is not too long without a space
txt_comment = SafeLength(Trim(Request.Form("txt_comment")))
'strip all html tags that are not welcomed
txt_comment = striphtml(txt_comment)
'check for links and insert a hrefs
txt_comment = httplink(txt_comment)
txt_comment = ftplink(txt_comment)
'does an auto (
insert) line return
txt_comment = Replace(txt_comment,chr(13),"
")
if Len(txt_comment) > 5000 then
'don't let really dumb ppl get away with junk, 5000 chr
'should be enough for serious feedback
txt_comment = Left(txt_comment,4940) & "... message has been cut short by LvL admin."
end if
posters_name = Trim(Request.Form("posters_name"))
if not posters_name = "" then
'do a quick security check or 2
'stops ANY html in names
posters_name = replace(posters_name,"<","<")
posters_name = replace(posters_name,">",">")
if Len(posters_name) > 36 then
posters_name = Left(posters_name,33) & "..."
end if
end if
'use this to help keep track of idiots, X_FORWARD tries to get past a proxy (or something like that)
ip_user = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
if ip_user = "" then
'REMOTE_ADDR is never blank, but often only a router
ip_user = Request.ServerVariables("REMOTE_ADDR")
end if
'now do a quick check see if they are a banned user
dim classC_check
'grabs the *1st* part of a class C for real asshole banning!
classC_check = mid(ip_user,1,(instr(instr(1,ip_user,".")+1,ip_user,".")+1))
set con = Server.CreateObject("ADODB.Connection")
con.Open(DSN)
'open the connection to the DSN (SQL server)
query = "select datestamp " & _
"from q3a_banned " & _
"where ((str_banned_ip like '" & ip_user & "%'" & _
") or (str_reason like '" & classC_check & "%'))" & _
" and (bit_active = 0)"
'Response.Write("query = [" & query & "]
")
set RS=con.Execute(query)
if not RS.eof then
'ALWAYS check of the EOF (end of file)
error = true
error_msg = error_msg & "Sorry, but you are a banned user, your ip number (well, it could be your proxy, router or gateway)" & _
" "& ip_user &" was banned on the "& funkydate(RS("datestamp")) &" - if you think there has been a mistake, " & _
"or you should NOT be banned then send an email off to "& tig_mail &""
end if
RS.Close
con.Close
'==================================================
'now do a quick check in the DB to stop double post
set con = Server.CreateObject("ADODB.Connection")
con.Open(DSN)
'open the connection to the DSN (SQL server)
query = "SELECT ip_user, msg_body, id_parent " & _
"FROM forum_msg (nolock) " & _
"WHERE (ip_user = '" & SQLSafe(ip_user) & "') AND " & _
" (msg_body = '" & SQLSafe(txt_comment) & "') AND " & _
" (id_parent = " & cint(id_parent) & ")"
'Response.Write("query = [" & query & "]
")
set RS=con.Execute(query)
if not RS.eof then
'ALWAYS check of the EOF (end of file)
error = true
error_msg = error_msg & "The post you are trying to add already exist, did you hit the submit button more than once?"
end if
RS.Close
con.Close
'===================
'ok, now we can ad the post at last!!
'===================
if not error then
set con = Server.CreateObject("ADODB.Connection")
con.Open(DSN)
'open the connection to the DSN (SQL server)
query = "INSERT INTO forum_msg " & _
" (ip_user, msg_body, id_parent, "
if Request.Cookies("lvl")("forumid") <> "" then
query = query & " id_user, "
end if
if posters_name <> "" then
query = query & " who_posted, "
end if
if Request.Form("show_sig") = "yes" then
query = query & " show_sig, "
end if
query = query & " datestamp) " & _
"VALUES " & _
" ('" & SQLSafe(ip_user) & "', '" & SQLSafe(txt_comment) & "', " & cint(id_parent) & ", "
if Request.Cookies("lvl")("forumid") <> "" then
query = query & ""& cint(Request.Cookies("lvl")("forumid")) &", "
end if
if posters_name <> "" then
query = query & "'" & SQLSafe(posters_name) & "', "
end if
if Request.Form("show_sig") = "yes" then
query = query & "1, "
end if
query = query & "getdate())"
'Response.Write("query = [" & query & "]
")
con.Execute(query)
'=============
'also update the time stamp of the last topic
'(more code this way, but less load on the SQL server
'later when pulling datestamp out ie, no need to question
'lots of msg's to get the most recent stamp??)
query = "UPDATE forum_msg " & _
"SET datestamp = GETDATE() " & _
"WHERE id = " & cint(id_parent)
con.Execute(query)
con.Close
'post added!!! - now take them back so they can see that their post was added
Response.Redirect(Request.ServerVariables("PATH_INFO") & "?id=" & id_parent & "&clear=" & switch)
end if
end function
'======================
'insert a new post into the database and makes sure there is double post too!
function insert_new_topic(byval parent_id, title, body, show_sig)
'1st do a quick check to stop doubleing up of post
set con = Server.CreateObject("ADODB.Connection")
con.Open(DSN)
'open the connection to the DSN (SQL server)
query = "SELECT id from forum_msg (nolock) " & _
"where is_topic = 1 and msg_title = '" & SQLSafe(title) & "'"
'for a quick debug of the query
'Response.Write("query = [" & query & "]
")
set RS=con.Execute(query)
if not RS.eof then
error = true
error_msg = error_msg & "The topic you are trying to post already exist on the ..::LvL Fourms database."
end if
con.close
if not error then
'only add if there is not an error
set con = Server.CreateObject("ADODB.Connection")
con.Open(DSN)
'open the connection to the DSN (SQL server)
query = "INSERT INTO forum_msg " & _
"(id_parent, is_topic, msg_title, id_user, ip_user, msg_body, show_sig) " & _
"VALUES (" & _
" " & parent_id & "," & _
" 1," & _
" '" & SQLSafe(title) & "'," & _
" '" & Request.Cookies("lvl")("forumid") & "'," & _
" '" & ip_dig & "'," & _
" '" & SQLSafe(body) & "', "
if show_sig = "yes" then
query = query & "1)"
else
query = query & "0)"
end if
'for a quick debug of the query
'Response.Write("query = [" & query & "]
")
con.Execute(query)
'thats added, now update the datestamp on the parent
'ok, so its another queue, but its less load later (i think)
query = "UPDATE forum_msg " & _
"SET datestamp = GETDATE() " & _
"WHERE id = " & cint(parent_id)
'for a quick debug of the query
'Response.Write("query = [" & query & "]
")
con.Execute(query)
con.close
new_topic_added = true
end if
end function
function forum_search(byval search_string, censored)
set con = Server.CreateObject("ADODB.Connection")
con.Open(DSN)
'open the connection to the DSN (SQL server)
query = "SELECT TOP 250 forum_msg.msg_title AS title, " & _
" forum_msg.datestamp AS datestamp, " & _
" forum_msg.who_posted AS who_posted, " & _
" forum_user.user_name AS user_name, " & _
" forum_msg.id_parent AS id_parent, " & _
" forum_msg1.msg_title AS topic_title, " & _
" forum_msg.id AS id " & _
"FROM forum_msg (nolock) LEFT OUTER JOIN " & _
" forum_msg forum_msg1 ON " & _
" forum_msg.id_parent = forum_msg1.id LEFT OUTER JOIN " & _
" forum_user ON " & _
" forum_msg.id_user = forum_user.id " & _
"WHERE "
if censored then
query = query & "(forum_msg.id_parent > 0 AND forum_msg.censored = 0) AND "
end if
query = query & " (forum_msg.msg_title LIKE '%"& SQLSafe(search_string) &"%' OR " & _
" forum_msg.who_posted LIKE '%"& SQLSafe(search_string) &"%' OR " & _
" forum_user.user_name LIKE '%"& SQLSafe(search_string) &"%' OR " & _
" forum_msg.msg_body LIKE '%"& SQLSafe(search_string) &"%') " & _
"ORDER BY forum_msg.datestamp DESC"
'for a quick debug of the query
'Response.Write("query = [" & query & "]
")
set RS=con.Execute(query)
if not RS.eof then
'ALWAYS check of the EOF (end of file)
'dump the entire query results into an array
search_results = RS.getRows()
end if
RS.Close
con.Close
end function
%>