<%
'#################################################################################
'## Copyright (C) 2000 Michael Anderson
'##
'## This program is free software; you can redistribute it and/or
'## modify it under the terms of the GNU General Public License
'## as published by the Free Software Foundation; either version 2
'## of the License, or any later version.
'##
'## This program is distributed in the hope that it will be useful,
'## but WITHOUT ANY WARRANTY; without even the implied warranty of
'## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
'## GNU General Public License for more details.
'##
'## You should have received a copy of the GNU General Public License
'## along with this program; if not, write to the Free Software
'## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
'##
'## Correspondence and Questions can be sent to:
'## reinhold@bigfoot.com
'##
'## or
'##
'## Snitz Communications
'## C/O: Michael Anderson
'## PO Box 200
'## Harpswell, ME 04079
'#################################################################################
%>
<%
function ChkUrls(fString, fTestTag, fType)
Dim strArray
Dim Counter
Dim strTempString
strTempString = fString
if Instr(1, fString, fTestTag) > 0 then
strArray = Split(fString, fTestTag, -1)
strTempString = strArray(0)
for counter = 1 to UBound(strArray)
if ((strArray(counter-1) = "" or len(strArray(counter-1)) < 5) and strArray(counter)<> "") then
strTempString = strTempString & edit_hrefs("" & fTestTag & strArray(counter), fType)
elseif ((UCase(right(strArray(counter-1),5)) <> "[URL]") and (UCase(right(strArray(counter-1),11)) <> "[URL="") and (UCase(right(strArray(counter-1),7)) <> "FILE:///") and (UCase(right(strArray(counter-1),7)) <> "HTTP://") and (UCase(right(strArray(counter-1),8)) <> "HTTPS://") and (UCase(right(strArray(counter-1),5)) <> "SRC=""") and (UCase(right(strArray(counter-1),10)) <> "SRC="") and strArray(counter)<> "") then
strTempString = strTempString & edit_hrefs("" & fTestTag & strArray(counter), fType)
else
strTempString = strTempString & fTestTag & strArray(counter)
end if
next
end if
ChkUrls = strTempString
end function
function FormatStr(fString)
on Error resume next
fString = Replace(fString, CHR(13), "")
fString = Replace(fString, CHR(10) & CHR(10), "
")
' fString = doCode(fString, "[url", "[/url]", "", "")
fString = replace(fString, "[br]", " ", 1, -1, 1)
if strIMGInPosts = "1" then
fString = doCode(fString, "[img]","[/img]","")
fString = doCode(fString, "[image]","[/image]","")
fString = doCode(fString, "[img=right]","[/img=right]","")
fString = doCode(fString, "[image=right]","[/image=right]","")
fString = doCode(fString, "[img=left]","[/img=left]","")
fString = doCode(fString, "[image=left]","[/image=left]","")
end if
end if
end if
if strIcons = "1" and _
fField_Type <> "title" then
fString= smile(fString)
end if
if fField_Type <> "hidden" then
fString = Replace(fString, "'", "''")
end if
ChkString = fString
end function
function ChkDateTime(fDateTime)
if fDateTime = "" then
exit function
end if
if IsDate(fDateTime) then
select case strDateType
case "dmy"
ChkDateTime = Mid(fDateTime,7,2) & "/" & _
Mid(fDateTime,5,2) & "/" & _
Mid(fDateTime,1,4)
case "mdy"
ChkDateTime = Mid(fDateTime,5,2) & "/" & _
Mid(fDateTime,7,2) & "/" & _
Mid(fDateTime,1,4)
case "ymd"
ChkDateTime = Mid(fDateTime,1,4) & "/" & _
Mid(fDateTime,5,2) & "/" & _
Mid(fDateTime,7,2)
case "ydm"
ChkDateTime =Mid(fDateTime,1,4) & "/" & _
Mid(fDateTime,7,2) & "/" & _
Mid(fDateTime,5,2)
case "dmmy"
ChkDateTime = Mid(fDateTime,7,2) & " " & _
Monthname(Mid(fDateTime,5,2),1) & " " & _
Mid(fDateTime,1,4)
case "mmdy"
ChkDateTime = Monthname(Mid(fDateTime,5,2),1) & " " & _
Mid(fDateTime,7,2) & " " & _
Mid(fDateTime,1,4)
case "ymmd"
ChkDateTime = Mid(fDateTime,1,4) & " " & _
Monthname(Mid(fDateTime,5,2),1) & " " & _
Mid(fDateTime,7,2)
case "ydmm"
ChkDateTime = Mid(fDateTime,1,4) & " " & _
Mid(fDateTime,7,2) & " " & _
Monthname(Mid(fDateTime,5,2),1)
case "dmmmy"
ChkDateTime = Mid(fDateTime,7,2) & " " & _
Monthname(Mid(fDateTime,5,2),0) & " " & _
Mid(fDateTime,1,4)
case "mmmdy"
ChkDateTime = Monthname(Mid(fDateTime,5,2),0) & " " & _
Mid(fDateTime,7,2) & " " & _
Mid(fDateTime,1,4)
case "ymmmd"
ChkDateTime = Mid(fDateTime,1,4) & " " & _
Monthname(Mid(fDateTime,5,2),0) & " " & _
Mid(fDateTime,7,2)
case "ydmmm"
ChkDateTime = Mid(fDateTime,1,4) & " " & _
Mid(fDateTime,7,2) & " " & _
Monthname(Mid(fDateTime,5,2),0)
case else
ChkDateTime = doublenum(Mid(fDateTime,5,2)) & "/" & _
Mid(fDateTime,7,2) & "/" & _
Mid(fDateTime,1,4)
end select
if strTimeType = 12 then
if cint(Mid(fDateTime, 9,2)) > 12 then
ChkDateTime = ChkDateTime & " " & _
(cint(Mid(fDateTime, 9,2)) -12) & ":" & _
Mid(fDateTime, 11,2) & ":" & _
Mid(fDateTime, 13,2) & " " & "PM"
elseif cint(Mid(fDateTime, 9,2)) = 12 then
ChkDateTime = ChkDateTime & " " & _
cint(Mid(fDateTime, 9,2)) & ":" & _
Mid(fDateTime, 11,2) & ":" & _
Mid(fDateTime, 13,2) & " " & "PM"
elseif cint(Mid(fDateTime, 9,2)) = 0 then
ChkDateTime = ChkDateTime & " " & _
(cint(Mid(fDateTime, 9,2)) +12) & ":" & _
Mid(fDateTime, 11,2) & ":" & _
Mid(fDateTime, 13,2) & " " & "AM"
else
ChkDateTime = ChkDateTime & " " & _
Mid(fDateTime, 9,2) & ":" & _
Mid(fDateTime, 11,2) & ":" & _
Mid(fDateTime, 13,2) & " " & "AM"
end if
else
ChkDateTime = ChkDateTime & " " & _
Mid(fDateTime, 9,2) & ":" & _
Mid(fDateTime, 11,2) & ":" & _
Mid(fDateTime, 13,2)
end if
end if
end function
function ChkDateFormat(strDateTime)
ChkDateFormat = isdate("" & Mid(strDateTime, 5,2) & "/" & Mid(strDateTime, 7,2) & "/" & Mid(strDateTime, 1,4) & " " & Mid(strDateTime, 9,2) & ":" & Mid(strDateTime, 11,2) & ":" & Mid(strDateTime, 13,2) & "")
end function
function StrToDate(strDateTime)
if ChkDateFormat(strDateTime) then
StrToDate = cdate("" & Mid(strDateTime, 5,2) & "/" & Mid(strDateTime, 7,2) & "/" & Mid(strDateTime, 1,4) & " " & Mid(strDateTime, 9,2) & ":" & Mid(strDateTime, 11,2) & ":" & Mid(strDateTime, 13,2) & "")
else
StrToDate = "" & strForumTimeAdjust
end if
end function
function DateToStr(dtDateTime)
DateToStr = year(dtDateTime) & doublenum(Month(dtdateTime)) & doublenum(Day(dtdateTime)) & doublenum(Hour(dtdateTime)) & doublenum(Minute(dtdateTime)) & doublenum(Second(dtdateTime)) & ""
end function
function ReadLastHereDate(UserName)
dim TempLastHereDate
dim rs_date
'## Forum_SQL
strSql = "SELECT " & strMemberTablePrefix & "MEMBERS.M_LASTHEREDATE "
strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS "
if strAuthType="db" then
strSql = strSql & " WHERE " & strMemberTablePrefix & "MEMBERS.M_NAME = '" & UserName & "' "
else
if strAuthType="nt" then
strSql = strSql & " WHERE " & strMemberTablePrefix & "MEMBERS.M_USERNAME = '" & session("userid") & "' "
end if
end if
set rs_date = my_conn.Execute (strSql)
if (rs_date.BOF and rs_date.EOF) then
TempLastHereDate = DateAdd("d",-10,strForumTimeAdjust)
else
TempLastHereDate = StrToDate(rs_date("M_LASTHEREDATE"))
if TempLastHereDate = "" or IsNull(TempLastHereDate) then
TempLastHereDate = DateAdd("d",-10,strForumTimeAdjust)
end if
end if
rs_date.close
set rs_date = nothing
'## Forum_SQL - Do DB Update
strSql = "UPDATE " & strMemberTablePrefix & "MEMBERS "
strSql = strSql & " SET M_LASTHEREDATE = '" & DateToStr(strForumTimeAdjust) & "'"
if strAuthType="db" then
strSql = strSql & " WHERE " & strMemberTablePrefix & "MEMBERS.M_NAME = '" & UserName & "' "
else
if strAuthType="nt" then
strSql = strSql & " WHERE " & strMemberTablePrefix & "MEMBERS.M_USERNAME = '" & session("userid") & "' "
end if
end if
my_conn.Execute (strSql)
ReadLastHereDate = DateToStr(TempLastHereDate)
end function
function getMemberID(fUser_Name)
'## Forum_SQL
strSql = "SELECT " & strMemberTablePrefix & "MEMBERS.MEMBER_ID "
strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS "
strSql = strSql & " WHERE M_NAME = '" & fUser_Name & "'"
rsGetMemberID = my_Conn.Execute(strSql)
getMemberID = rsGetMemberID("M_NAME")
end function
function ChkDate(fDate)
if fDate = "" then
exit function
end if
'if IsDate(fDate) then
select case strDateType
case "dmy"
ChkDate = Mid(fDate,7,2) & "/" & _
Mid(fDate,5,2) & "/" & _
Mid(fDate,1,4)
case "mdy"
ChkDate = Mid(fDate,5,2) & "/" & _
Mid(fDate,7,2) & "/" & _
Mid(fDate,1,4)
case "ymd"
ChkDate = Mid(fDate,1,4) & "/" & _
Mid(fDate,5,2) & "/" & _
Mid(fDate,7,2)
case "ydm"
ChkDate =Mid(fDate,1,4) & "/" & _
Mid(fDate,7,2) & "/" & _
Mid(fDate,5,2)
case "dmmy"
ChkDate = Mid(fDate,7,2) & " " & _
Monthname(Mid(fDate,5,2),1) & " " & _
Mid(fDate,1,4)
case "mmdy"
ChkDate = Monthname(Mid(fDate,5,2),1) & " " & _
Mid(fDate,7,2) & " " & _
Mid(fDate,1,4)
case "ymmd"
ChkDate = Mid(fDate,1,4) & " " & _
Monthname(Mid(fDate,5,2),1) & " " & _
Mid(fDate,7,2)
case "ydmm"
ChkDate = Mid(fDate,1,4) & " " & _
Mid(fDate,7,2) & " " & _
Monthname(Mid(fDate,5,2),1)
case "dmmmy"
ChkDate = Mid(fDate,7,2) & " " & _
Monthname(Mid(fDate,5,2),0) & " " & _
Mid(fDate,1,4)
case "mmmdy"
ChkDate = Monthname(Mid(fDate,5,2),0) & " " & _
Mid(fDate,7,2) & " " & _
Mid(fDate,1,4)
case "ymmmd"
ChkDate = Mid(fDate,1,4) & " " & _
Monthname(Mid(fDate,5,2),0) & " " & _
Mid(fDate,7,2)
case "ydmmm"
ChkDate = Mid(fDate,1,4) & " " & _
Mid(fDate,7,2) & " " & _
Monthname(Mid(fDate,5,2),0)
case else
ChkDate = Mid(fDate,5,2) & "/" & _
Mid(fDate,7,2) & "/" & _
Mid(fDate,1,4)
End Select
'end if
end function
function ChkTime(fTime)
if fTime = "" then
exit function
end if
if strTimeType = 12 then
if cint(Mid(fTime, 9,2)) > 12 then
ChkTime = ChkTime & " " & _
(cint(Mid(fTime, 9,2)) -12) & ":" & _
Mid(fTime, 11,2) & ":" & _
Mid(fTime, 13,2) & " " & "PM"
elseif cint(Mid(fTime, 9,2)) = 12 then
ChkTime = ChkTime & " " & _
cint(Mid(fTime, 9,2)) & ":" & _
Mid(fTime, 11,2) & ":" & _
Mid(fTime, 13,2) & " " & "PM"
elseif cint(Mid(fTime, 9,2)) = 0 then
ChkTime = ChkTime & " " & _
(cint(Mid(fTime, 9,2)) +12) & ":" & _
Mid(fTime, 11,2) & ":" & _
Mid(fTime, 13,2) & " " & "AM"
else
ChkTime = ChkTime & " " & _
Mid(fTime, 9,2) & ":" & _
Mid(fTime, 11,2) & ":" & _
Mid(fTime, 13,2) & " " & "AM"
end if
else
ChkTime = ChkTime & " " & _
Mid(fTime, 9,2) & ":" & _
Mid(fTime, 11,2) & ":" & _
Mid(fTime, 13,2)
end if
end function
function EmailField(fTestString)
TheAt = Instr(2, fTestString, "@")
if TheAt = 0 then
EmailField = 0
else
TheDot = Instr(cint(TheAt) + 2, fTestString, ".")
if TheDot = 0 then
EmailField = 0
else
if cint(TheDot) + 1 > Len(fTestString) then
EmailField = 0
else
EmailField = -1
end if
end if
end if
end function
function ChkIsNew(fDateTime)
if strHotTopic = "1" then
if fDateTime > session("last_here_date") then
if rs("T_REPLIES") >= intHotTopicNum then
ChkIsNew = ""
else
ChkIsNew = ""
end if
else
if rs("T_REPLIES") >= intHotTopicNum then
ChkIsNew = ""
else
ChkIsNew = ""
end if
end if
else
if fDateTime > session("last_here_date") then
ChkIsNew = ""
else
ChkIsNew = ""
end if
end if
end function
function ChkQuoteOk(fString)
ChkQuoteOk = not(InStr(1, fString, "'", 0) > 0)
end function
function ChkUser(fName, fPassword)
'## Forum_SQL
strSql = "SELECT " & strMemberTablePrefix & "MEMBERS.MEMBER_ID, " & strMemberTablePrefix & "MEMBERS.M_LEVEL, " & strMemberTablePrefix & "MEMBERS.M_NAME, " & strMemberTablePrefix & "MEMBERS.M_PASSWORD "
strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS "
if strAuthType="db" then
strSql = strSql & " WHERE " & strMemberTablePrefix & "MEMBERS.M_NAME = '" & fName & "' "
strSql = strSql & " AND " & strMemberTablePrefix & "MEMBERS.M_PASSWORD = '" & fPassword &"'"
else
if strAuthType="nt" then
strSql = strSql & " WHERE " & strMemberTablePrefix & "MEMBERS.M_USERNAME = '" & session("userid") & "' "
end if
end if
strSql = strSql & " AND " & strMemberTablePrefix & "MEMBERS.M_STATUS = " & 1
set rsCheck = my_Conn.Execute (strSql)
if rsCheck.BOF or rsCheck.EOF or not(ChkQuoteOk(fName)) or not(ChkQuoteOk(fPassword)) then
ChkUser = 0
else
if cstr(rsCheck("MEMBER_ID")) = Request.Form("Author") then
ChkUser = 1 '## Author
else
Select case cint(rsCheck("M_LEVEL"))
case 1
ChkUser = 2 '## Normal User
case 2
ChkUser = 3 '## Moderator
case 3
ChkUser = 4 '## Admin
case else
ChkUser = cint(rsCheck("M_LEVEL"))
End Select
end if
end if
rsCheck.close
set rsCheck = nothing
end function
function ChkUser2(fName, fPassword)
'## Forum_SQL
strSql = "SELECT " & strMemberTablePrefix & "MEMBERS.MEMBER_ID, " & strMemberTablePrefix & "MEMBERS.M_LEVEL, " & strMemberTablePrefix & "MEMBERS.M_NAME, " & strMemberTablePrefix & "MEMBERS.M_PASSWORD "
strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS "
if strAuthType="db" then
strSql = strSql & " WHERE " & strMemberTablePrefix & "MEMBERS.M_NAME = '" & fName & "' "
strSql = strSql & " AND " & strMemberTablePrefix & "MEMBERS.M_PASSWORD = '" & fPassword &"'"
else
if strAuthType="nt" then
strSql = strSql & " WHERE " & strMemberTablePrefix & "MEMBERS.M_USERNAME = '" & session("userid") & "' "
end if
end if
strSql = strSql & " AND " & strMemberTablePrefix & "MEMBERS.M_STATUS = " & 1
set rsCheck = my_Conn.Execute (strSql)
if rsCheck.BOF or rsCheck.EOF or not(ChkQuoteOk(fName)) or not(ChkQuoteOk(fPassword)) then
ChkUser2 = 0 '## Invalid Password
else
if cint(rsCheck("MEMBER_ID")) = cint(Request.QueryString("Author")) then
ChkUser2 = 1 '## Author
else
select case cint(rsCheck("M_LEVEL"))
case 1
ChkUser2 = 2 '## Normal User
case 2
ChkUser2 = 3 '## Moderator
case 3
ChkUser2 = 4 '## Admin
case else
ChkUser2 = cint(rsCheck("M_LEVEL"))
end select
end if
end if
rsCheck.close
set rsCheck = nothing
end function
function ChkUser3(fName, fPassword, fReply)
'## Forum_SQL
strSql = "SELECT " & strMemberTablePrefix & "MEMBERS.MEMBER_ID, " & strMemberTablePrefix & "MEMBERS.M_LEVEL, " & strMemberTablePrefix & "MEMBERS.M_NAME, " & strMemberTablePrefix & "MEMBERS.M_PASSWORD, " & strTablePrefix & "REPLY.R_AUTHOR "
strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS, " & strTablePrefix & "REPLY "
if strAuthType="db" then
strSql = strSql & " WHERE " & strMemberTablePrefix & "MEMBERS.M_NAME = '" & fName & "' "
strSql = strSql & " AND " & strMemberTablePrefix & "MEMBERS.M_PASSWORD = '" & fPassword & "' "
else
if strAuthType="nt" then
strSql = strSql & " WHERE " & strMemberTablePrefix & "MEMBERS.M_USERNAME = '" & session("userid") & "' "
end if
end if
strSql = strSql & " AND " & strTablePrefix & "REPLY.REPLY_ID = " & fReply
strSql = strSql & " AND " & strMemberTablePrefix & "MEMBERS.M_STATUS = " & 1
set rsCheck = my_Conn.Execute (strSql)
if rsCheck.BOF or rsCheck.EOF or not(ChkQuoteOk(fName)) or not(ChkQuoteOk(fPassword)) then
ChkUser3 = 0 '## Invalid Password
else
if cint(rsCheck("MEMBER_ID")) = cint(rsCheck("R_AUTHOR")) then
ChkUser3 = 1 '## Author
else
Select case cint(rsCheck("M_LEVEL"))
case 1
ChkUser3 = 2 '## Normal User
case 2
ChkUser3 = 3 '## Moderator
case 3
ChkUser3 = 4 '## Admin
case else
ChkUser3 = cint(rsCheck("M_LEVEL"))
End Select
end if
end if
rsCheck.close
set rsCheck = nothing
end function
function GetSig(fUser_Name)
'## Forum_SQL
strSql = "SELECT M_SIG "
strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS "
strSql = strSql & " WHERE M_NAME = '" & Request.Form("UserName") & "'"
set rsSig = my_Conn.Execute (strSql)
if rsSig.EOF or rsSig.BOF then
'## Do Nothing
else
GetSig = rsSig("M_SIG")
end if
rsSig.close
set rsSig = nothing
end function
function DoDropDown(fTableName, fDisplayField, fValueField, fSelectValue, fName)
'## Forum_SQL
strSql = "SELECT " & fDisplayField & ", " & fValueField
strSql = strSql & " FROM " & fTableName
rsdrop.Open strSql, my_Conn
Response.Write "" & vbCrLf
rsdrop.Close
set rsdrop = nothing
end function
sub DoULastPost(sUser_Name)
'## Forum_SQL - Updates the M_LASTPOSTDATE in the FORUM_MEMBERS table
strSql = "UPDATE " & strMemberTablePrefix & "MEMBERS "
strSql = strSql & " SET M_LASTPOSTDATE = '" & DateToStr(strForumTimeAdjust) & "' "
if strAuthType="db" then
strSql = strSql & " WHERE M_NAME = '" & sUser_Name & "'"
else
if strAuthType="nt" then
strSql = strSql & " WHERE M_USERNAME = '" & session("userid") & "'"
end if
end if
my_Conn.Execute (strSql)
end sub
'##############################################
'## Ranks and Stars ##
'##############################################
sub doMember_Level()
if rs("M_TITLE") <> " " then
Member_Level = Member_Level & rs("M_TITLE")
else
select case rs("M_LEVEL")
case "1"
if cint(rs("M_POSTS")) < intRankLevel1 then Member_Level = Member_Level & strRankLevel0
if (cint(rs("M_POSTS")) >= intRankLevel1) and (cint(rs("M_POSTS")) < intRankLevel2) then Member_Level = Member_Level & strRankLevel1
if (cint(rs("M_POSTS")) >= intRankLevel2) and (cint(rs("M_POSTS")) < intRankLevel3) then Member_Level = Member_Level & strRankLevel2
if (cint(rs("M_POSTS")) >= intRankLevel3) and (cint(rs("M_POSTS")) < intRankLevel4) then Member_Level = Member_Level & strRankLevel3
if (cint(rs("M_POSTS")) >= intRankLevel4) and (cint(rs("M_POSTS")) < intRankLevel5) then Member_Level = Member_Level & strRankLevel4
if (cint(rs("M_POSTS")) >= intRankLevel5) then Member_Level = Member_Level & strRankLevel5
case "2"
Member_Level = Member_Level & strRankMod
case "3"
Member_Level = Member_Level & strRankAdmin
case else
Member_Level = Member_Level & "Error"
end select
end if
end sub
sub doStar_Level()
select case rs("M_LEVEL")
case "1"
if cint(rs("M_POSTS")) < intRankLevel1 then Star_Level = Star_Level & ""
if (cint(rs("M_POSTS")) >= intRankLevel1) and (cint(rs("M_POSTS")) < intRankLevel2) then Star_Level = Star_Level & ""
if (cint(rs("M_POSTS")) >= intRankLevel2) and (cint(rs("M_POSTS")) < intRankLevel3) then Star_Level = Star_Level & ""
if (cint(rs("M_POSTS")) >= intRankLevel3) and (cint(rs("M_POSTS")) < intRankLevel4) then Star_Level = Star_Level & ""
if (cint(rs("M_POSTS")) >= intRankLevel4) and (cint(rs("M_POSTS")) < intRankLevel5) then Star_Level = Star_Level & ""
if (cint(rs("M_POSTS")) >= intRankLevel5) then Star_Level = Star_Level & ""
case "2"
if cint(rs("M_POSTS")) < intRankLevel1 then Star_Level = Star_Level & ""
if (cint(rs("M_POSTS")) >= intRankLevel1) and (cint(rs("M_POSTS")) < intRankLevel2) then Star_Level = Star_Level & ""
if (cint(rs("M_POSTS")) >= intRankLevel2) and (cint(rs("M_POSTS")) < intRankLevel3) then Star_Level = Star_Level & ""
if (cint(rs("M_POSTS")) >= intRankLevel3) and (cint(rs("M_POSTS")) < intRankLevel4) then Star_Level = Star_Level & ""
if (cint(rs("M_POSTS")) >= intRankLevel4) and (cint(rs("M_POSTS")) < intRankLevel5) then Star_Level = Star_Level & ""
if (cint(rs("M_POSTS")) >= intRankLevel5) then Star_Level = Star_Level & ""
case "3"
if cint(rs("M_POSTS")) < intRankLevel1 then Star_Level = Star_Level & ""
if (cint(rs("M_POSTS")) >= intRankLevel1) and (cint(rs("M_POSTS")) < intRankLevel2) then Star_Level = Star_Level & ""
if (cint(rs("M_POSTS")) >= intRankLevel2) and (cint(rs("M_POSTS")) < intRankLevel3) then Star_Level = Star_Level & ""
if (cint(rs("M_POSTS")) >= intRankLevel3) and (cint(rs("M_POSTS")) < intRankLevel4) then Star_Level = Star_Level & ""
if (cint(rs("M_POSTS")) >= intRankLevel4) and (cint(rs("M_POSTS")) < intRankLevel5) then Star_Level = Star_Level & ""
if (cint(rs("M_POSTS")) >= intRankLevel5) then Star_Level = Star_Level & ""
case else
Star_Level = Star_Level & "Error"
end select
end sub
'##############################################
'## Multi-Moderators ##
'##############################################
function chkForumModerator(fForum_ID, fMember_Name)
'## Forum_SQL
strSql = "SELECT " & strMemberTablePrefix & "MEMBERS.MEMBER_ID "
strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS "
if strAuthType = "db" then
strSql = strSql & " WHERE " & strMemberTablePrefix & "MEMBERS.M_NAME = '" & fMember_Name & "'"
else
if strAuthType = "nt" then
strSql = strSql & " WHERE " & strMemberTablePrefix & "MEMBERS.M_USERNAME = '" & fMember_Name & "'"
end if
end if
set rsUsrName = my_Conn.Execute (strSql)
if rsUsrName.EOF or rsUsrName.BOF or not(ChkQuoteOk(fMember_Name)) or not(ChkQuoteOk(fForum_ID)) then
chkForumModerator = "0"
rsUsrName.close
exit function
else
MEMBER_ID = rsUsrName("MEMBER_ID")
rsUsrName.close
end if
set rsUsrName = nothing
'## Forum_SQL
strSql = "SELECT * "
strSql = strSql & " FROM " & strTablePrefix & "MODERATOR "
strSql = strSql & " WHERE FORUM_ID = " & fForum_ID & " "
strSql = strSql & " AND MEMBER_ID = " & MEMBER_ID
set rsChk = my_Conn.Execute (strSql)
if rsChk.bof or rsChk.eof then
chkForumModerator = "0"
else
chkForumModerator = "1"
end if
rsChk.close
set rsChk = nothing
end function
function listForumModerators(fForum_ID)
'## Forum_SQL
strSql = "SELECT * "
strSql = strSql & " FROM " & strTablePrefix & "Moderator "
strSql = strSql & " WHERE FORUM_ID = " & fForum_ID
set rsChk = my_Conn.Execute (strSql)
if rsChk.EOF or not(ChkQuoteOk(fForum_ID)) then
listForumModerators = ""
exit function
end if
fMods = getMemberName(rsChk("MEMBER_ID"))
rsChk.MoveNext
do until rsChk.EOF
fMods = fMods & ", " & getMemberName(rsChk("MEMBER_ID"))
rsChk.MoveNext
loop
rsChk.close
set rsChk = nothing
listForumModerators = fMods
end function
function getMemberName(fUser_Number)
'## Forum_SQL
strSql = "SELECT " & strMemberTablePrefix & "MEMBERS.M_NAME "
strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS "
strSql = strSql & " WHERE MEMBER_ID = " & fUser_Number
rsGetMemberID = my_Conn.Execute(strSql)
getMemberName = rsGetMemberID("M_NAME")
end function
function getMemberNumber(fUser_Name)
'## Forum_SQL
strSql = "SELECT " & strMemberTablePrefix & "MEMBERS.MEMBER_ID "
strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS "
strSql = strSql & " WHERE M_NAME = '" & fUser_Name & "'"
set rsGetMemberID = my_Conn.Execute(strSql)
if rsGetMemberID.EOF or rsGetMemberID.BOF then
getMemberNumber = -1
exit function
end if
getMemberNumber = rsGetMemberID("MEMBER_ID")
end function
'##############################################
'## NT Authentication ##
'##############################################
sub NTUser()
if session("username")="" then
'## Forum_SQL
strSql ="SELECT " & strMemberTablePrefix & "MEMBERS.MEMBER_ID, " & strMemberTablePrefix & "MEMBERS.M_LEVEL, " & strMemberTablePrefix & "MEMBERS.M_PASSWORD, " & strMemberTablePrefix & "MEMBERS.M_USERNAME, " & strMemberTablePrefix & "MEMBERS.M_NAME "
strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS "
strSql = strSql & " WHERE " & strMemberTablePrefix & "MEMBERS.M_USERNAME = '" & Session("userid") & "'"
strSql = strSql & " AND " & strMemberTablePrefix & "MEMBERS.M_STATUS = " & 1
set rs_chk = my_conn.Execute (strSql)
if rs_chk.BOF or rs_chk.EOF then
strLoginStatus = 0
else
session("username") = rs_chk("M_NAME")
if strSetCookieToForum = 1 then
Response.Cookies("User").Path = strCookieURL
end if
Response.Cookies("User")("Name") = rs_chk("M_NAME")
Response.Cookies("User")("Pword") = rs_chk("M_PASSWORD")
Response.Cookies("User")("Cookies") = ""
Response.Cookies("User").Expires = dateAdd("d", 30, strForumTimeAdjust)
Session("last_here_date") = ReadLastHereDate(rs_chk("M_NAME"))
strLoginStatus = 1
mLev = cint(ChkUser2(Request.Cookies("User")("Name"), Request.Cookies("User")("Pword")))
if mLev = 4 then
Session("Approval") = "15916941253"
end if
end if
rs_chk.close
set rs_chk = nothing
end if
end sub
function ChkAccountReg()
'## Forum_SQL
strSql ="SELECT " & strMemberTablePrefix & "MEMBERS.MEMBER_ID, " & strMemberTablePrefix & "MEMBERS.M_LEVEL, " & strMemberTablePrefix & "MEMBERS.M_USERNAME "
strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS "
strSql = strSql & " WHERE " & strMemberTablePrefix & "MEMBERS.M_USERNAME = '" & Session("userid") & "'"
strSql = strSql & " AND " & strMemberTablePrefix & "MEMBERS.M_STATUS = " & 1
set rs_chk = my_conn.Execute (strSql)
if rs_chk.BOF or rs_chk.EOF then
ChkAccountReg = "0"
else
ChkAccountReg = "1"
end if
rs_chk.close
set rs_chk = nothing
end function
sub NTAuthenticate()
dim strUser, strPath
if Session("userid") = "" then
strUser = Request.ServerVariables("AUTH_USER")
strUser = replace(strUser, "\", "/")
strUser = Mid(strUser,(instr(1,strUser,"/")+1),len(strUser))
Session("userid") = strUser
end if
end sub
function chkDisplayForum(fForum_ID)
if (mlev = 4) then
chkDisplayForum= true
exit function
end if
'## Forum_SQL - load the user list
strSql = "SELECT " & strTablePrefix & "FORUM.F_USERLIST, " & strTablePrefix & "FORUM.F_PRIVATEFORUMS "
strSql = strSql & " FROM " & strTablePrefix & "FORUM "
strSql = strSql & " WHERE FORUM_ID = " & fForum_ID
set rsAccess = my_Conn.Execute(strSql)
select case rsAccess("F_PRIVATEFORUMS")
case 0, 1, 2, 3, 4, 7, 8
chkDisplayForum= true
exit function
case 5
UserNum = getNewMemberNumber()
if UserNum = - 1 then
chkDisplayForum= false
exit function
else
chkDisplayForum= true
exit function
end if
case 6
UserNum = getNewMemberNumber()
if UserNum = - 1 then
chkDisplayForum= false
exit function
end if
if Instr(rsAccess("F_USERLIST"), ", ") > 0 then
Users = Split(rsAccess("F_USERLIST"), ", ")
elseif trim(rsAccess("F_USERLIST")) <> "" then ' Only 1 member assigned to forum
chkDisplayForum = (cint(rsAccess("F_USERLIST")) = cint(UserNum))
exit function
else ' No members assigned to forum
chkDisplayForum = false
exit function
end if
MatchFound = 0
for i = 0 to ubound(Users)
if cint(Users(i)) = cint(UserNum) then
MatchFound = 1
exit for
end if
next
if MatchFound = 1 then
chkDisplayForum= true
Else
chkDisplayForum= false
end if
case else
chkDisplayForum= true
end select
end function
'##############################################
'## Cookie functions and Subs ##
'##############################################
sub DoCookies()
if strSetCookieToForum = 1 then
Response.Cookies("User").Path = strCookieURL
end if
Response.Cookies("User")("Name") = Request.Form("UserName")
Response.Cookies("User")("Pword") = Request.Form("Password")
Response.Cookies("User")("Cookies") = Request.Form("Cookies")
Response.Cookies("User").Expires = dateAdd("d", 30, strForumTimeAdjust)
end sub
sub ClearCookies()
if strSetCookieToForum = 1 then
Response.Cookies("User").Path = strCookieURL
end if
Response.Cookies("User") = ""
Response.Cookies("User").Expires = dateadd("d", -2, strForumTimeAdjust)
end sub
'##############################################
'## Do Counts ##
'##############################################
sub DoPCount()
'## Forum_SQL - Updates the totals Table
strSql ="UPDATE " & strTablePrefix & "TOTALS SET " & strTablePrefix & "TOTALS.P_COUNT = " & strTablePrefix & "TOTALS.P_COUNT + 1"
my_Conn.Execute (strSql)
end sub
sub DoTCount()
'## Forum_SQL - Updates the totals Table
strSql ="UPDATE " & strTablePrefix & "TOTALS SET " & strTablePrefix & "TOTALS.T_COUNT = " & strTablePrefix & "TOTALS.T_COUNT + 1"
my_Conn.Execute (strSql)
end sub
sub DoUCount(sUser_Name)
'## Forum_SQL - Update Total Post for user
strSql = "UPDATE " & strMemberTablePrefix & "MEMBERS "
strSql = strSql & " SET " & strMemberTablePrefix & "MEMBERS.M_POSTS = " & strMemberTablePrefix & "MEMBERS.M_POSTS + 1 "
if strAuthType="db" then
strSql = strSql & " WHERE M_NAME = '" & sUser_Name & "'"
else
if strAuthType="nt" then
strSql = strSql & " WHERE M_USERNAME = '" & session("userid") & "'"
end if
end if
my_Conn.Execute (strSql)
end sub
'##############################################
'## Private Forums ##
'##############################################
sub chkUser4()
set my_Conn = Server.CreateObject("ADODB.Connection")
my_Conn.Open strConnString
'## Forum_SQL
strSql = "SELECT " & strTablePrefix & "FORUM.F_PRIVATEFORUMS, " & strTablePrefix & "FORUM.F_USERLIST, " & strTablePrefix & "FORUM.F_SUBJECT, " & strTablePrefix & "FORUM.F_PASSWORD "
strSql = strSql & " FROM " & strTablePrefix & "FORUM "
strSql = strSql & " WHERE " & strTablePrefix & "FORUM.Forum_ID = " & Request.QueryString("FORUM_ID")
set rsStatus = my_conn.Execute (strSql)
dim Users
If cint(rsStatus("F_PRIVATEFORUMS")) <> 0 then
'if Request.Cookies("User")("Name") <> "" or ChkAccountReg() = "1" then
Select case cint(rsStatus("F_PRIVATEFORUMS"))
case 0
'## Do Nothing
case 1, 6 '## Allowed Users
UserNum = getNewMemberNumber()
if Instr(rsStatus("F_USERLIST"), ", ") > 0 then
Users = Split(rsStatus("F_USERLIST"), ", ")
elseif trim(rsStatus("F_USERLIST")) <> "" then ' Only 1 member assigned to forum
if (cint(rsStatus("F_USERLIST")) = cint(UserNum)) then
exit sub
else
doNotAllowed
Response.end
end if
else ' No members assigned to forum
doNotAllowed
Response.end
end if
MatchFound = 0
for i = 0 to ubound(Users)
if cint(Users(i)) = cint(UserNum) then
MatchFound = 1
exit for
end if
next
if MatchFound then
exit sub
else
doNotAllowed
Response.end
end if
case 2 '## password
select case Request.Cookies("User")("PRIVATE_" & rsStatus("F_SUBJECT"))
case rsStatus("F_Password")
'## OK
case else
if Request("pass") = "" then
doPasswordForm
Response.End
else
if Request("pass") <> rsStatus("F_PASSWORD") then
Response.Write "Invalid password! Back"
Response.End
else
if strSetCookieToForum = 1 then
Response.Cookies("User").Path = strCookieURL
end if
Response.Cookies("User")("PRIVATE_" & rsStatus("F_SUBJECT")) = Request("pass")
end if
end if
end select
case 3 '## Either Password or Allowed
UserNum = getNewMemberNumber()
if Instr(rsStatus("F_USERLIST"), ", ") > 0 then
Users = Split(rsStatus("F_USERLIST"), ", ")
elseif trim(rsStatus("F_USERLIST")) <> "" then ' Only 1 member assigned to forum
if (cint(rsStatus("F_USERLIST")) = cint(UserNum)) then
exit sub
else
doNotAllowed
Response.end
end if
else ' No members assigned to forum
doNotAllowed
Response.end
end if
MatchFound = 0
for i = 0 to ubound(Users)
if cint(Users(i)) = cint(UserNum) then
MatchFound = 1
exit for
end if
next
if MatchFound then
exit sub
else
select case Request.Cookies("User")("PRIVATE_" & rsStatus("F_SUBJECT"))
case rsStatus("F_Password")
'## OK
case else
if Request("pass") = "" then
doLoginForm
Response.End
else
if Request("pass") <> rsStatus("F_PASSWORD") then
Response.Write "Invalid password! Back"
Response.End
else
if strSetCookieToForum = 1 then
Response.Cookies("User").Path = strCookieURL
end if
Response.Cookies("User")("PRIVATE_" & rsStatus("F_SUBJECT")) = Request("pass")
end if
end if
end select
end if
'## code added 07/13/2000
case 7 '## members or password
if (strAuthType="db" and Request.Cookies("User")("Name") = "") or (strAuthType="nt" and session("username") = "") then
select case Request.Cookies("User")("PRIVATE_" & rsStatus("F_SUBJECT"))
case rsStatus("F_Password")
'## OK
case else
if Request("pass") = "" then
doLoginForm
Response.End
else
if Request("pass") <> rsStatus("F_PASSWORD") then
Response.Write "Invalid password! Back"
Response.End
else
if strSetCookieToForum = 1 then
Response.Cookies("User").Path = strCookieURL
end if
Response.Cookies("User")("PRIVATE_" & rsStatus("F_SUBJECT")) = Request("pass")
end if
end if
end select
end if
'## end code added 07/13/2000
case 4, 5 '## members only
if strAuthType="db" and Request.Cookies("User")("Name") = "" then
doNotLoggedInForm
else
if strAuthType="nt" and session("username") = "" then
doNotLoggedInForm
end if
end if
case else
Response.Write " ERROR: Invalid forum type: " & rsStatus("F_PRIVATEFORUMS")
Response.end
end select
'else
' doNotLoggedInForm
'end if
end if
my_Conn.Close
set my_Conn = nothing
end sub
function chkForumAccess(fForum)
'## Forum_SQL
strSql = "SELECT " & strTablePrefix & "FORUM.F_PRIVATEFORUMS, " & strTablePrefix & "FORUM.F_USERLIST, " & strTablePrefix & "FORUM.F_SUBJECT, " & strTablePrefix & "FORUM.F_PASSWORD "
strSql = strSql & " FROM " & strTablePrefix & "FORUM "
strSql = strSql & " WHERE " & strTablePrefix & "FORUM.Forum_ID = " & fForum
set rsStatus = my_conn.Execute (strSql)
dim Users
dim MatchFound
If cint(rsStatus("F_PRIVATEFORUMS")) <> 0 then
' if Request.Cookies("User")("Name") <> "" or ChkAccountReg() = "1" then
Select case cint(rsStatus("F_PRIVATEFORUMS"))
case 0
chkForumAccess = true
case 1, 6 '## Allowed Users
UserNum = getNewMemberNumber()
if Instr(rsStatus("F_USERLIST"), ", ") > 0 then
Users = Split(rsStatus("F_USERLIST"), ", ")
elseif trim(rsStatus("F_USERLIST")) <> "" then ' Only 1 member assigned to forum
chkForumAccess = (cint(rsStatus("F_USERLIST")) = cint(UserNum))
exit function
else ' No members assigned to forum
chkForumAccess = false
exit function
end if
for i = 0 to ubound(Users)
if cint(Users(i)) = cint(UserNum) then
chkForumAccess = true
exit for
end if
next
case 2 '## password
select case Request.Cookies("User")("PRIVATE_" & rsStatus("F_SUBJECT"))
case rsStatus("F_Password")
chkForumAccess = true
case else
if Request("pass") = "" then
chkForumAccess = false
else
if Request("pass") <> rsStatus("F_PASSWORD") then
chkForumAccess = false
else
if strSetCookieToForum = 1 then
Response.Cookies("User").Path = strCookieURL
end if
Response.Cookies("User")("PRIVATE_" & rsStatus("F_SUBJECT")) = Request("pass")
chkForumAccess = true
end if
end if
end select
case 3 '## Either Password or Allowed
UserNum = getNewMemberNumber()
' Users = Split(rsStatus("F_USERLIST"), ", ")
if Instr(rsStatus("F_USERLIST"), ", ") > 0 then
Users = Split(rsStatus("F_USERLIST"), ", ")
elseif trim(rsStatus("F_USERLIST")) <> "" then ' Only 1 member assigned to forum
chkForumAccess = (cint(rsStatus("F_USERLIST")) = cint(UserNum))
exit function
else ' No members assigned to forum
chkForumAccess = false
exit function
end if
for i = 0 to ubound(Users)
if cint(Users(i)) = cint(UserNum) then
chkForumAccess = true
exit for
end if
next
if not(chkForumAccess) then
select case Request.Cookies("User")("PRIVATE_" & rsStatus("F_SUBJECT"))
case rsStatus("F_Password")
chkForumAccess = true
case else
if Request("pass") = "" then
chkForumAccess = false
else
if Request("pass") <> rsStatus("F_PASSWORD") then
chkForumAccess = false
else
if strSetCookieToForum = 1 then
Response.Cookies("User").Path = strCookieURL
end if
Response.Cookies("User")("PRIVATE_" & rsStatus("F_SUBJECT")) = Request("pass")
chkForumAccess = true
end if
end if
end select
end if
'## code added 07/13/2000
case 7 '## members or password
if (strAuthType="db" and Request.Cookies("User")("Name") = "") or (strAuthType="nt" and session("username") = "") then
select case Request.Cookies("User")("PRIVATE_" & rsStatus("F_SUBJECT"))
case rsStatus("F_Password")
chkForumAccess = true
case else
if Request("pass") = "" then
chkForumAccess = false
else
if Request("pass") <> rsStatus("F_PASSWORD") then
chkForumAccess = false
else
if strSetCookieToForum = 1 then
Response.Cookies("User").Path = strCookieURL
end if
Response.Cookies("User")("PRIVATE_" & rsStatus("F_SUBJECT")) = Request("pass")
chkForumAccess = true
end if
end if
end select
end if
'## end code added 07/13/2000
case 4, 5 '## members only
if strAuthType="db" and Request.Cookies("User")("Name") = "" then
chkForumAccess = false
else
chkForumAccess = not(strAuthType="nt" and session("username") = "")
end if
case else
chkForumAccess = true
end select
' else
' chkForumAccess = false
' end if
else
chkForumAccess = true
end if
end function
function chkAccess(fForum)
'## Forum_SQL - load the user list
strSql = "SELECT " & strTablePrefix & "FORUM.F_USERLIST, " & strTablePrefix & "FORUM.F_PRIVATEFORUMS FROM " & strTablePrefix & "FORUM WHERE FORUM_ID = " & fForum
set rsAccess = my_Conn.Execute(strSql)
if rsAccess("F_PRIVATEFORUMS") <> 1 then
chkAccess = true
exit function
end if
if Request.Cookies("User")("Name") = "" then
chkAccess = false
end if
'get the member number
UserNum = getMemberNumber(Request.Cookies("User")("Name"))
Users = Split(rsAccess("F_USERLIST"), ", ")
MatchFound = 0
for i = 0 to ubound(Users)
if cint(Users(i)) = cint(UserNum) then
MatchFound = 1
exit for
end if
next
if MatchFound = 1 then
chkAccess = true
Else
chkAccess = false
end if
End function
sub doLoginForm()
%>
There Was A Problem
You do not have access to this forum.
>If you have been given special permission by the administrator to view and/or post in this forum, enter the password here:
", "[:(!]", 1, -1, 1)
fString= replace(fString, "
", "[B)]", 1, -1, 1)
fString= replace(fString, "
", "[xx(]", 1, -1, 1)
fString= replace(fString, "
", "[:O]", 1, -1, 1)
fString= replace(fString, "
", "[:I]", 1, -1, 1)
fString= replace(fString, "
", "[:(]", 1, -1, 1)
fString= replace(fString, "
", "[8)]", 1, -1, 1)
fString= replace(fString, "
", "[:)]", 1, -1, 1)
fString= replace(fString, "
", "[}:)]", 1, -1, 1)
fString= replace(fString, "
", "[:D]", 1, -1, 1)
fString= replace(fString, "
", "[8D]", 1, -1, 1)
fString= replace(fString, "
", "[|)]", 1, -1, 1)
fString= replace(fString, "
", "[:o)]", 1, -1, 1)
fString= replace(fString, "
", "[:P]", 1, -1, 1)
fString= replace(fString, "
", "[;)]", 1, -1, 1)
fString= replace(fString, "
", "[8]", 1, -1, 1)
fString= replace(fString, "
", "[?]", 1, -1, 1)
fString= replace(fString, "
", "[^]", 1, -1, 1)
fString= replace(fString, "
", "[V]", 1, -1, 1)
fString= replace(fString, "
", "[:X]", 1, -1, 1)
fString= replace(fString, "
"
else
ChkIsNew = "
"
end if
else
if rs("T_REPLIES") >= intHotTopicNum then
ChkIsNew = "
"
else
ChkIsNew = "
"
end if
end if
else
if fDateTime > session("last_here_date") then
ChkIsNew = "