") fString = Replace(fString, CHR(10), "
") if strBadWordFilter = 1 then fString = ChkBadWords(fString) end if fString = ChkUrls(fString,"http://", 1) fString = ChkUrls(fString,"https://", 2) fString = ChkUrls(fString,"file:///", 3) fString = ChkUrls(fString,"www.", 4) fString = ChkUrls(fString,"mailto:",5) fString = ChkMail(fString," ",5) 'fString = edit_hrefs(fString, 5) fString = ReplaceUrls(fString) FormatStr = fString end function function doublenum(fNum) if fNum > 9 then doublenum = fNum else doublenum = "0" & fNum end if end function function widenum(fNum) if fNum > 9 then widenum = "" else widenum = " " end if end function function Chked(fYN) if fYN = "yes" or fYN = "1" or fYN = 1 then '** Chked = " Checked" else Chked = "" end if end function function doCode(fString, fOTag, fCTag, fROTag, fRCTag) fOTagPos = Instr(1, fString, fOTag, 1) fCTagPos = Instr(1, fString, fCTag, 1) while (fCTagPos > 0 and fOTagPos > 0) fString = replace(fString, fOTag, fROTag, 1, 1, 1) fString = replace(fString, fCTag, fRCTag, 1, 1, 1) fOTagPos = Instr(1, fString, fOTag, 1) fCTagPos = Instr(1, fString, fCTag, 1) wend doCode = fString end function function CleanCode(fString) if fString = "" then fString = " " else if strAllowForumCode = "1" then fString = replace(fString, "","[b]", 1, -1, 1) fString = replace(fString, "","[/b]", 1, -1, 1) fString = replace(fString, "", "[s]", 1, -1, 1) fString = replace(fString, "", "[/s]", 1, -1, 1) fString = replace(fString, "","[u]", 1, -1, 1) fString = replace(fString, "","[/u]", 1, -1, 1) fString = replace(fString, "","[i]", 1, -1, 1) fString = replace(fString, "","[/i]", 1, -1, 1) fString = replace(fString, "", "[font=Andale Mono]", 1, -1, 1) fString = replace(fString, "", "[/font=Andale Mono]", 1, -1, 1) fString = replace(fString, "", "[font=Arial]", 1, -1, 1) fString = replace(fString, "", "[/font=Arial]", 1, -1, 1) fString = replace(fString, "", "[font=Arial Black]", 1, -1, 1) fString = replace(fString, "", "[/font=Arial Black]", 1, -1, 1) fString = replace(fString, "", "[font=Book Antiqua]", 1, -1, 1) fString = replace(fString, "", "[/font=Book Antiqua]", 1, -1, 1) fString = replace(fString, "", "[font=Century Gothic]", 1, -1, 1) fString = replace(fString, "", "[/font=Century Gothic]", 1, -1, 1) fString = replace(fString, "", "[font=Comic Sans MS]", 1, -1, 1) fString = replace(fString, "", "[/font=Comic Sans MS]", 1, -1, 1) fString = replace(fString, "", "[font=Courier New]", 1, -1, 1) fString = replace(fString, "", "[/font=Courier New]", 1, -1, 1) fString = replace(fString, "", "[font=Georgia]", 1, -1, 1) fString = replace(fString, "", "[/font=Georgia]", 1, -1, 1) fString = replace(fString, "", "[font=Impact]", 1, -1, 1) fString = replace(fString, "", "[/font=Impact]", 1, -1, 1) fString = replace(fString, "", "[font=Tahoma]", 1, -1, 1) fString = replace(fString, "", "[/font=Tahoma]", 1, -1, 1) fString = replace(fString, "", "[font=Times New Roman]", 1, -1, 1) fString = replace(fString, "", "[/font=Times New Roman]", 1, -1, 1) fString = replace(fString, "", "[font=Trebuchet MS]", 1, -1, 1) fString = replace(fString, "", "[/font=Trebuchet MS]", 1, -1, 1) fString = replace(fString, "", "[font=Script MT Bold]", 1, -1, 1) fString = replace(fString, "", "[/font=Script MT Bold]", 1, -1, 1) fString = replace(fString, "", "[font=Stencil]", 1, -1, 1) fString = replace(fString, "", "[/font=Stencil]", 1, -1, 1) fString = replace(fString, "", "[font=Verdana]", 1, -1, 1) fString = replace(fString, "", "[/font=Verdana]", 1, -1, 1) fString = replace(fString, "", "[font=Lucida Console]", 1, -1, 1) fString = replace(fString, "", "[/font=Lucida Console]", 1, -1, 1) fString = replace(fString, "", "[red]", 1, -1, 1) fString = replace(fString, "", "[/red]", 1, -1, 1) fString = replace(fString, "", "[green]", 1, -1, 1) fString = replace(fString, "", "[/green]", 1, -1, 1) fString = replace(fString, "", "[blue]", 1, -1, 1) fString = replace(fString, "", "[/blue]", 1, -1, 1) fString = replace(fString, "", "[white]", 1, -1, 1) fString = replace(fString, "", "[/white]", 1, -1, 1) fString = replace(fString, "", "[purple]", 1, -1, 1) fString = replace(fString, "", "[/purple]", 1, -1, 1) fString = replace(fString, "", "[yellow]", 1, -1, 1) fString = replace(fString, "", "[/yellow]", 1, -1, 1) fString = replace(fString, "", "[violet]", 1, -1, 1) fString = replace(fString, "", "[/violet]", 1, -1, 1) fString = replace(fString, "", "[brown]", 1, -1, 1) fString = replace(fString, "", "[/brown]", 1, -1, 1) fString = replace(fString, "", "[black]", 1, -1, 1) fString = replace(fString, "", "[/black]", 1, -1, 1) fString = replace(fString, "", "[pink]", 1, -1, 1) fString = replace(fString, "", "[/pink]", 1, -1, 1) fString = replace(fString, "", "[orange]", 1, -1, 1) fString = replace(fString, "", "[/orange]", 1, -1, 1) fString = replace(fString, "", "[gold]", 1, -1, 1) fString = replace(fString, "", "[/gold]", 1, -1, 1) fString = replace(fString, "", "[beige]", 1, -1, 1) fString = replace(fString, "", "[/beige]", 1, -1, 1) fString = replace(fString, "", "[teal]", 1, -1, 1) fString = replace(fString, "", "[/teal]", 1, -1, 1) fString = replace(fString, "", "[navy]", 1, -1, 1) fString = replace(fString, "", "[/navy]", 1, -1, 1) fString = replace(fString, "", "[maroon]", 1, -1, 1) fString = replace(fString, "", "[/maroon]", 1, -1, 1) fString = replace(fString, "", "[limegreen]", 1, -1, 1) fString = replace(fString, "", "[/limegreen]", 1, -1, 1) fString = replace(fString, "

", "[h1]", 1, -1, 1) fString = replace(fString, "

", "[h2]", 1, -1, 1) fString = replace(fString, "

", "[h3]", 1, -1, 1) fString = replace(fString, "

", "[h4]", 1, -1, 1) fString = replace(fString, "

", "[h5]", 1, -1, 1) fString = replace(fString, "

", "[h6]", 1, -1, 1) fString = replace(fString, "

","[list]", 1, -1, 1) fString = replace(fString, "

","[list=1]", 1, -1, 1) fString = replace(fString, "

","[list=a]", 1, -1, 1) fString = replace(fString, "

quote:

---

","[quote]", 1, -1, 1) fString = replace(fString, "

---

","[/quote]", 1, -1, 1) fString = replace(fString, "

","[code]", 1, -1, 1)
			fString = replace(fString, "

","[/code]", 1, -1, 1) if strIMGInPosts = "1" then fString = replace(fString, "","[/img]", 1, -1, 1) fString = replace(fString, """ id=right border=0>","[/img=right]", 1, -1, 1) fString = replace(fString, """ id=left border=0>","[/img=left]", 1, -1, 1) end if end if if strIcons = "1" then fString= replace(fString, "", "[:(!]", 1, -1, 1) fString= replace(fString, "", "[B)]", 1, -1, 1) fString= replace(fString, "", "[xx(]", 1, -1, 1) fString= replace(fString, "", "[XX(]", 1, -1, 1) fString= replace(fString, "", "[:O]", 1, -1, 1) fString= replace(fString, "", "[:o]", 1, -1, 1) fString= replace(fString, "", "[:0]", 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, "", "[:O)]", 1, -1, 1) fString= replace(fString, "", "[:0)]", 1, -1, 1) fString= replace(fString, "", "[:P]", 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, "", "[v]", 1, -1, 1) fString= replace(fString, "", "[:X]", 1, -1, 1) fString= replace(fString, "", "[:x]", 1, -1, 1) end if end if fString = Replace(fString, "'", "'") CleanCode = fString end function function Smile(fString) fString = replace(fString, "[:(!]", "") fString = replace(fString, "[B)]", "") fString = replace(fString, "[xx(]", "") fString = replace(fString, "[XX(]", "") fString = replace(fString, "[:I]", "") fString = replace(fString, "[:(]", "") fString = replace(fString, "[:o]", "") fString = replace(fString, "[:O]", "") fString = replace(fString, "[:0]", "") fString = replace(fString, "[|)]", "") fString = replace(fString, "[:)]", "") fString = replace(fString, "[:D]", "") fString = replace(fString, "[}:)]", "") fString = replace(fString, "[:o)]", "") fString = replace(fString, "[:O)]", "") fString = replace(fString, "[:0)]", "") fString = replace(fString, "[8)]", "") fString = replace(fString, "[8D]", "") fString = replace(fString, "[:P]", "") fString = replace(fString, "[:p]", "") fString = replace(fString, "[;)]", "") fString = replace(fString, "[8]", "") fString = replace(fString, "[?]", "") fString = replace(fString, "[^]", "") fString = replace(fString, "[V]", "") fString = replace(fString, "[v]", "") fString = replace(fString, "[:X]", "") fString = replace(fString, "[:x]", "") Smile = fString end function function ChkBadWords(fString) bwords = split(strBadWords, "|") for i = 0 to ubound(bwords) fString = Replace(fString, bwords(i), string(len(bwords(i)),"*"), 1,-1,1) next ChkBadWords = fString end function function HTMLEncode(fString) fString = replace(fString, ">", ">") fString = replace(fString, "<", "<") HTMLEncode = fString end function function HTMLDecode(fString) fString = replace(fString, ">", ">") fString = replace(fString, "<", "<") HTMLDecode = fString end function function ChkString(fString,fField_Type) '## Types - name, password, title, message, url, urlpath, email, number, list fString = trim(fString) if fString = "" then fString = " " else ' ChkBadWords(fString) end if if fField_Type = "decode" then fString = HTMLDecode(fString) ChkString = fString exit function end if if fField_Type = "urlpath" then fString = Server.URLEncode(fString) ChkString = fString exit function end if if fField_Type = "SQLString" then fString = Replace(fString, "'", "''") fString = HTMLEncode(fString) ChkString = fString exit function end if if fField_Type = "JSurlpath" then fString = Replace(fString, "'", "\'") fString = Server.URLEncode(fString) ChkString = fString exit function end if if fField_Type = "display" then if strAllowHTML <> "1" then fString = HTMLEncode(fString) end if ChkString = fString exit function elseif fField_Type = "message" then if strAllowHTML <> "1" then fString = HTMLEncode(fString) end if elseif fField_Type = "hidden" then fString = HTMLEncode(fString) end if if strAllowForumCode = "1" and fField_Type <> "signature" then fString = doCode(fString, "[b]", "[/b]", "", "") fString = doCode(fString, "[s]", "[/s]", "", "") fString = doCode(fString, "[strike]", "[/strike]", "", "") fString = doCode(fString, "[u]", "[/u]", "", "") fString = doCode(fString, "[i]", "[/i]", "", "") if fField_Type <> "title" then fString = doCode(fString, "[font=Andale Mono]", "[/font=Andale Mono]", "", "") fString = doCode(fString, "[font=Arial]", "[/font=Arial]", "", "") fString = doCode(fString, "[font=Arial Black]", "[/font=Arial Black]", "", "") fString = doCode(fString, "[font=Book Antiqua]", "[/font=Book Antiqua]", "", "") fString = doCode(fString, "[font=Century Gothic]", "[/font=Century Gothic]", "", "") fString = doCode(fString, "[font=Courier New]", "[/font=Courier New]", "", "") fString = doCode(fString, "[font=Comic Sans MS]", "[/font=Comic Sans MS]", "", "") fString = doCode(fString, "[font=Georgia]", "[/font=Georgia]", "", "") fString = doCode(fString, "[font=Impact]", "[/font=Impact]", "", "") fString = doCode(fString, "[font=Tahoma]", "[/font=Tahoma]", "", "") fString = doCode(fString, "[font=Times New Roman]", "[/font=Times New Roman]", "", "") fString = doCode(fString, "[font=Trebuchet MS]", "[/font=Trebuchet MS]", "", "") fString = doCode(fString, "[font=Script MT Bold]", "[/font=Script MT Bold]", "", "") fString = doCode(fString, "[font=Stencil]", "[/font=Stencil]", "", "") fString = doCode(fString, "[font=Verdana]", "[/font=Verdana]", "", "") fString = doCode(fString, "[font=Lucida Console]", "[/font=Lucida Console]", "", "") fString = doCode(fString, "[red]", "[/red]", "", "") fString = doCode(fString, "[green]", "[/green]", "", "") fString = doCode(fString, "[blue]", "[/blue]", "", "") fString = doCode(fString, "[white]", "[/white]", "", "") fString = doCode(fString, "[purple]", "[/purple]", "", "") fString = doCode(fString, "[yellow]", "[/yellow]", "", "") fString = doCode(fString, "[violet]", "[/violet]", "", "") fString = doCode(fString, "[brown]", "[/brown]", "", "") fString = doCode(fString, "[black]", "[/black]", "", "") fString = doCode(fString, "[pink]", "[/pink]", "", "") fString = doCode(fString, "[orange]", "[/orange]", "", "") fString = doCode(fString, "[gold]", "[/gold]", "", "") fString = doCode(fString, "[beige]", "[/beige]", "", "") fString = doCode(fString, "[teal]", "[/teal]", "", "") fString = doCode(fString, "[navy]", "[/navy]", "", "") fString = doCode(fString, "[maroon]", "[/maroon]", "", "") fString = doCode(fString, "[limegreen]", "[/limegreen]", "", "") fString = doCode(fString, "[h1]", "[/h1]", "

", "

") fString = doCode(fString, "[h2]", "[/h2]", "

", "

") fString = doCode(fString, "[h3]", "[/h3]", "

", "

") fString = doCode(fString, "[h4]", "[/h4]", "

", "

") fString = doCode(fString, "[h5]", "[/h5]", "

", "

") fString = doCode(fString, "[h6]", "[/h6]", "

", "

") fString = doCode(fString, "[size=1]", "[/size=1]", "", "") fString = doCode(fString, "[size=2]", "[/size=2]", "", "") fString = doCode(fString, "[size=3]", "[/size=3]", "", "") fString = doCode(fString, "[size=4]", "[/size=4]", "", "") fString = doCode(fString, "[size=5]", "[/size=5]", "", "") fString = doCode(fString, "[size=6]", "[/size=6]", "", "") fString = doCode(fString, "[list]", "[/list]", "

", "

") fString = doCode(fString, "[list=1]", "[/list=1]", "

", "

") fString = doCode(fString, "[list=a]", "[/list=a]", "

", "

") fString = doCode(fString, "[*]", "[/*]", "

", "

") fString = doCode(fString, "[left]", "[/left]", "

", "

") fString = doCode(fString, "[center]", "[/center]", "", "") fString = doCode(fString, "[centre]", "[/centre]", "", "") fString = doCode(fString, "[right]", "[/right]", "

", "

") fString = doCode(fString, "[code]", "[/code]", "

", "

") fString = doCode(fString, "[quote]", "[/quote]", "

quote:

---

", "

---

") 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" and _ fField_Type <> "hidden" then fString= smile(fString) end if if fField_Type = "preview" then if strAllowHTML <> "1" then fString = HTMLEncode(fString) end if end if if fField_Type <> "hidden" and _ fField_Type <> "preview" 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 " strSql = strSql & " WHERE " & strMemberTablePrefix & "MEMBERS."&Strdbntsqlname&" = '" & UserName & "' " 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) & "'" strSql = strSql & " WHERE " & strMemberTablePrefix & "MEMBERS." & strDBNTSQLName & " = '" & UserName & "' " 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("MEMBER_ID") 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(strCookieURL & "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(strCookieURL & "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 " strSql = strSql & " WHERE " & strMemberTablePrefix & "MEMBERS." & strDBNTSQLName & " = '" & fName & "' " if strAuthType="db" then strSql = strSql & " AND " & strMemberTablePrefix & "MEMBERS.M_PASSWORD = '" & fPassword &"'" 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 " StrSql = strSql & " WHERE " & strMemberTablePrefix & "MEMBERS." & strDBNTSQLName & " = '" & fName & "' " if strAuthType="db" then strSql = strSql & " AND " & strMemberTablePrefix & "MEMBERS.M_PASSWORD = '" & fPassword &"'" End If strSql = strSql & " AND " & strMemberTablePrefix & "MEMBERS.M_STATUS = " & 1 on error resume next set rsCheck = my_Conn.Execute (strSql) for counter = 0 to my_Conn.Errors.Count -1 if my_Conn.Errors(counter).Number <> 0 or Err.number > 0 then ChkUser2 = -1 my_Conn.Errors.Clear end if next if rsCheck.BOF or rsCheck.EOF or not(ChkQuoteOk(fName)) or not(ChkQuoteOk(fPassword)) or ChkUser2 = -1 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 " StrSql = strSql & " WHERE " & strMemberTablePrefix & "MEMBERS." & strDBNTSQLName & " = '" & fName & "' " if strAuthType="db" then strSql = strSql & " AND " & strMemberTablePrefix & "MEMBERS.M_PASSWORD = '" & fPassword &"' " 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 "" if rsdrop.EOF or rsdrop.BOF then Response.Write "No Items Found" & vbCrLf else do until rsdrop.EOF if rs(fValueField) = cint(fSelectValue) then Response.Write "" Response.Write rsdrop(fDisplayField) & "" & vbCrLf else Response.Write "" Response.Write rsdrop(fDisplayField) & "" & vbCrLf end if rsdrop.MoveNext loop end if 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) & "' " strSql = strSql & " WHERE " & strDBNTSQLName & " = '" & sUser_Name & "'" my_Conn.Execute (strSql) end sub '############################################## '## Ranks and Stars ## '############################################## function getMember_Level(fM_TITLE, fM_LEVEL, fM_POSTS) dim Member_Level Member_Level = "" if Trim(fM_TITLE) <> "" then Member_Level = fM_TITLE else select case fM_LEVEL case "1" if (fM_POSTS < intRankLevel1) then Member_Level = Member_Level & strRankLevel0 if (fM_POSTS >= intRankLevel1) and (fM_POSTS < intRankLevel2) then Member_Level = Member_Level & strRankLevel1 if (fM_POSTS >= intRankLevel2) and (fM_POSTS < intRankLevel3) then Member_Level = Member_Level & strRankLevel2 if (fM_POSTS >= intRankLevel3) and (fM_POSTS < intRankLevel4) then Member_Level = Member_Level & strRankLevel3 if (fM_POSTS >= intRankLevel4) and (fM_POSTS < intRankLevel5) then Member_Level = Member_Level & strRankLevel4 if (fM_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 getMember_Level = Member_Level end function function getStar_Level(fM_LEVEL, fM_POSTS) dim Star_Level Star_Level = "" select case fM_LEVEL case "1" if (fM_POSTS < intRankLevel1) then Star_Level = Star_Level & "" if (fM_POSTS >= intRankLevel1) and (fM_POSTS < intRankLevel2) then Star_Level = Star_Level & "" if (fM_POSTS >= intRankLevel2) and (fM_POSTS < intRankLevel3) then Star_Level = Star_Level & "" if (fM_POSTS >= intRankLevel3) and (fM_POSTS < intRankLevel4) then Star_Level = Star_Level & "" if (fM_POSTS >= intRankLevel4) and (fM_POSTS < intRankLevel5) then Star_Level = Star_Level & "" if (fM_POSTS >= intRankLevel5) then Star_Level = Star_Level & "" case "2" if fM_POSTS < intRankLevel1 then Star_Level = Star_Level & "" if (fM_POSTS >= intRankLevel1) and (fM_POSTS < intRankLevel2) then Star_Level = Star_Level & "" if (fM_POSTS >= intRankLevel2) and (fM_POSTS < intRankLevel3) then Star_Level = Star_Level & "" if (fM_POSTS >= intRankLevel3) and (fM_POSTS < intRankLevel4) then Star_Level = Star_Level & "" if (fM_POSTS >= intRankLevel4) and (fM_POSTS < intRankLevel5) then Star_Level = Star_Level & "" if (fM_POSTS >= intRankLevel5) then Star_Level = Star_Level & "" case "3" if (fM_POSTS < intRankLevel1) then Star_Level = Star_Level & "" if (fM_POSTS >= intRankLevel1) and (fM_POSTS < intRankLevel2) then Star_Level = Star_Level & "" if (fM_POSTS >= intRankLevel2) and (fM_POSTS < intRankLevel3) then Star_Level = Star_Level & "" if (fM_POSTS >= intRankLevel3) and (fM_POSTS < intRankLevel4) then Star_Level = Star_Level & "" if (fM_POSTS >= intRankLevel4) and (fM_POSTS < intRankLevel5) then Star_Level = Star_Level & "" if (fM_POSTS >= intRankLevel5) then Star_Level = Star_Level & "" case else Star_Level = Star_Level & "Error" end select getStar_Level = Star_Level end function '############################################## '## Multi-Moderators ## '############################################## function chkForumModerator(fForum_ID, fMember_Name) '## Forum_SQL strSql = "SELECT " & strMemberTablePrefix & "MEMBERS.MEMBER_ID " strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS " strSql = strSql & " WHERE " & strMemberTablePrefix & "MEMBERS." & strDBNTSQLName & " = '" & fMember_Name & "'" 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 set rsGetMemberID = my_Conn.Execute(strSql) if rsGetMemberID.EOF or rsGetMemberID.BOF then getMemberName = "" else getMemberName = rsGetMemberID("M_NAME") end if 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(strCookieURL & "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(strCookieURL & "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(strCookieURL & "username") = rs_chk("M_NAME") if strSetCookieToForum = 1 then Response.Cookies(strUniqueID & "User").Path = strCookieURL end if Response.Cookies(strUniqueID & "User")("Name") = rs_chk("M_NAME") Response.Cookies(strUniqueID & "User")("Pword") = rs_chk("M_PASSWORD") Response.Cookies(strUniqueID & "User")("Cookies") = "" Response.Cookies(strUniqueID & "User").Expires = dateAdd("d", 30, strForumTimeAdjust) Session(strCookieURL & "last_here_date") = ReadLastHereDate(Request.Form("Name")) if strAuthType = "nt" then Session(strCookieURL & "last_here_date") = ReadLastHereDate(Session(strCookieURL & "userID")) end if strLoginStatus = 1 mLev = cint(ChkUser2(Request.Cookies(strUniqueID & "User")("Name"), Request.Cookies(strUniqueID & "User")("Pword"))) if mLev = 4 then Session(strCookieURL & "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.M_LEVEL, " & strMemberTablePrefix & "MEMBERS.M_USERNAME " strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS " strSql = strSql & " WHERE " & strMemberTablePrefix & "MEMBERS.M_USERNAME = '" & Session(strCookieURL & "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, strNTUser, checkNT strNTUser = Request.ServerVariables("AUTH_USER") strNTUser = replace(strNTUser, "\", "/") if Session(strCookieURL & "userid") = "" then strUser = Mid(strNTUser,(instr(1,strNTUser,"/")+1),len(strNTUser)) Session(strCookieURL & "userid") = strUser end if if strNTGroups="1" then strNTGroupsSTR = Session(strCookieURL & "strNTGroupsSTR") if Session(strCookieURL & "strNTGroupsSTR") = "" then Set strNTUserInfo = GetObject("WinNT://"+strNTUser) For Each strNTUserInfoGroup in strNTUserInfo.Groups strNTGroupsSTR=strNTGroupsSTR+", "+strNTUserInfoGroup.name NEXT Session(strCookieURL & "strNTGroupsSTR") = strNTGroupsSTR end if end if if strAutoLogon="1" then strNTUserFullName = Session(strCookieURL & "strNTUserFullName") if Session(strCookieURL & "strNTUserFullName") = "" then Set strNTUserInfo = GetObject("WinNT://"+strNTUser) strNTUserFullName=strNTUserInfo.FullName Session(strCookieURL & "strNTUserFullName") = strNTUserFullName end if 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_PRIVATEFORUMS, " & strTablePrefix & "FORUM.F_PASSWORD_NEW " 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, 9 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 MatchFound = isAllowedMember(fForum_ID,UserNum) if MatchFound = 1 then chkDisplayForum= true Else chkDisplayForum= false end if case 8 chkDisplayForum= false if strAuthType="nt" THEN NTGroupSTR = Split(strNTGroupsSTR, ", ") for j = 0 to ubound(NTGroupSTR) NTGroupDBSTR = Split(rsAccess("F_PASSWORD_NEW"), ", ") for i = 0 to ubound(NTGroupDBSTR) if NTGroupDBSTR(i) = NTGroupSTR(j) then chkDisplayForum= true exit function end if next next End if case else chkDisplayForum= true end select end function '############################################## '## Cookie functions and Subs ## '############################################## sub DoCookies(fSavePassWord) if strSetCookieToForum = 1 then Response.Cookies(strUniqueID & "User").Path = strCookieURL else Response.Cookies(strUniqueID & "User").Path = "/" end if Response.Cookies(strUniqueID & "User")("Name") = strDBNTFUserName Response.Cookies(strUniqueID & "User")("Pword") = Request.Form("Password") Response.Cookies(strUniqueID & "User")("Cookies") = Request.Form("Cookies") if fSavePassWord = "true" then Response.Cookies(strUniqueID & "User").Expires = dateAdd("d", 30, strForumTimeAdjust) end if Session(strCookieURL & "last_here_date") = ReadLastHereDate(strDBNTFUserName) end sub sub ClearCookies() if strSetCookieToForum = 1 then Response.Cookies(strUniqueID & "User").Path = strCookieURL else Response.Cookies(strUniqueID & "User").Path = "/" end if Response.Cookies(strUniqueID & "User") = "" 'Response.Cookies(strUniqueID & "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 " strSql = strSql & " WHERE " & strDBNTSQLName & " = '" & sUser_Name & "'" ' my_Conn.Execute (strSql) end sub '############################################## '## Private Forums ## '############################################## sub chkUser4() if mLev = 4 then exit sub end if '## Forum_SQL strSql = "SELECT " & strTablePrefix & "FORUM.F_PRIVATEFORUMS, " & strTablePrefix & "FORUM.F_SUBJECT, " & strTablePrefix & "FORUM.F_PASSWORD_NEW " 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 Select case cint(rsStatus("F_PRIVATEFORUMS")) case 0 '## Do Nothing case 1, 6 '## Allowed Users UserNum = getNewMemberNumber() MatchFound = isAllowedMember(Request.QueryString("FORUM_ID"), cint(UserNum)) if MatchFound then exit sub else doNotAllowed Response.end end if case 2 '## password select case Request.Cookies(strUniqueID & "User")("PRIVATE_" & rsStatus("F_SUBJECT")) case rsStatus("F_PASSWORD_NEW") '## OK case else if Request("pass") = "" then doPasswordForm Response.End else if Request("pass") <> rsStatus("F_PASSWORD_NEW") then Response.Write "Invalid password! Back" Response.End else if strSetCookieToForum = 1 then Response.Cookies(strUniqueID & "User").Path = strCookieURL end if Response.Cookies(strUniqueID & "User")("PRIVATE_" & rsStatus("F_SUBJECT")) = Request("pass") end if end if end select case 3 '## Either Password or Allowed UserNum = getNewMemberNumber() MatchFound = isAllowedMember(Request.QueryString("FORUM_ID"), cint(UserNum)) if MatchFound then exit sub else select case Request.Cookies(strUniqueID & "User")("PRIVATE_" & rsStatus("F_SUBJECT")) case rsStatus("F_PASSWORD_NEW") '## OK case else if Request("pass") = "" then doLoginForm Response.End else if Request("pass") <> rsStatus("F_PASSWORD_NEW") then Response.Write "Invalid password! Back" Response.End else if strSetCookieToForum = 1 then Response.Cookies(strUniqueID & "User").Path = strCookieURL end if Response.Cookies(strUniqueID & "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 (strDBNTUserName = "") then select case Request.Cookies(strUniqueID & "User")("PRIVATE_" & rsStatus("F_SUBJECT")) case rsStatus("F_PASSWORD_NEW") '## OK case else if Request("pass") = "" then doLoginForm Response.End else if Request("pass") <> rsStatus("F_PASSWORD_NEW") then Response.Write "Invalid password! Back" Response.End else if strSetCookieToForum = 1 then Response.Cookies(strUniqueID & "User").Path = strCookieURL end if Response.Cookies(strUniqueID & "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 strDBNTUserName = "" then doNotLoggedInForm end if case 8, 9 NTGroupSTR = Split(strNTGroupsSTR, ", ") NTGroupDBSTR = Split(rsStatus("F_PASSWORD_NEW"), ", ") For i = 0 to ubound(NTGroupDBSTR) for j = 0 to ubound(NTGroupSTR) if NTGroupDBSTR(i) = NTGroupSTR(j) then exit SUB end if next next doNotAllowed Response.end case else Response.Write "
ERROR: Invalid forum type: " & rsStatus("F_PRIVATEFORUMS") Response.end end select end if 'my_Conn.Close 'set my_Conn = nothing end sub function chkForumAccess(fForum) if mLev = 4 then chkForumAccess = true exit function end if '## Forum_SQL strSql = "SELECT " & strTablePrefix & "FORUM.F_PRIVATEFORUMS, " & strTablePrefix & "FORUM.F_SUBJECT, " & strTablePrefix & "FORUM.F_PASSWORD_NEW " 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 Select case cint(rsStatus("F_PRIVATEFORUMS")) case 0 chkForumAccess = true case 1, 6 '## Allowed Users UserNum = getNewMemberNumber() ' chkForumAccess = (isAllowedMember(fForum_ID,UserNum) = 1) chkForumAccess = (isAllowedMember(fForum,UserNum) = 1) case 2 '## password select case Request.Cookies(strUniqueID & "User")("PRIVATE_" & rsStatus("F_SUBJECT")) case rsStatus("F_PASSWORD_NEW") chkForumAccess = true case else if Request("pass") = "" then chkForumAccess = false else if Request("pass") <> rsStatus("F_PASSWORD_NEW") then chkForumAccess = false else if strSetCookieToForum = 1 then Response.Cookies(strUniqueID & "User").Path = strCookieURL end if Response.Cookies(strUniqueID & "User")("PRIVATE_" & rsStatus("F_SUBJECT")) = Request("pass") chkForumAccess = true end if end if end select case 3 '## Either Password or Allowed UserNum = getNewMemberNumber() ' if countMembers(fForum) = 0 then ' chkForumAccess = false ' exit function ' end if if isAllowedMember(fForum,UserNum) = 1 then chkForumAccess = true else chkForumAccess = false end if if not(chkForumAccess) then select case Request.Cookies(strUniqueID & "User")("PRIVATE_" & rsStatus("F_SUBJECT")) case rsStatus("F_PASSWORD_NEW") chkForumAccess = true case else if Request("pass") = "" then chkForumAccess = false else if Request("pass") <> rsStatus("F_PASSWORD_NEW") then chkForumAccess = false else if strSetCookieToForum = 1 then Response.Cookies(strUniqueID & "User").Path = strCookieURL end if Response.Cookies(strUniqueID & "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 strDBNTUserName = "" then select case Request.Cookies(strUniqueID & "User")("PRIVATE_" & rsStatus("F_SUBJECT")) case rsStatus("F_PASSWORD_NEW") chkForumAccess = true case else if Request("pass") = "" then chkForumAccess = false else if Request("pass") <> rsStatus("F_PASSWORD_NEW") then chkForumAccess = false else if strSetCookieToForum = 1 then Response.Cookies(strUniqueID & "User").Path = strCookieURL end if Response.Cookies(strUniqueID & "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 strDBNTUserName = "" then chkForumAccess = false else 'V3.1 SR4 chkForumAccess = true end if case 8, 9 test="test db" chkForumAccess = FALSE if strAuthType="db" then chkForumAccess = true exit function end if NTGroupSTR = Split(strNTGroupsSTR, ", ") for j = 0 to ubound(NTGroupSTR) NTGroupDBSTR = Split(rsStatus("F_PASSWORD_NEW"), ", ") for i = 0 to ubound(NTGroupDBSTR) if NTGroupDBSTR(i) = NTGroupSTR(j) then chkForumAccess = True exit function end if next next case else chkForumAccess = true end select else chkForumAccess = true end if end function function chkAccess(fForum) if mLev = 4 then chkAccess = true exit function end if '## Forum_SQL - load the user list strSql = "SELECT " & 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(strUniqueID & "User")("Name") = "" then chkAccess = false end if 'get the member number UserNum = getMemberNumber(Request.Cookies(strUniqueID & "User")("Name")) ' if isAllowedMember(fForum_ID,UserNum) = 1 then if isAllowedMember(fForum,UserNum) = 1 then 'V3.1 SR4 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:

" id=form2 name=form2> <% for each q in Request.QueryString Response.Write "" next %>

>Go Back To Enter Data

>Return to the forum

<% end sub sub doNotAllowed() %>

There Was A Problem

You do not have access to this forum.

>Go Back To Enter Data

>Return to the forum

<% end sub sub doPasswordForm() %>

There Was A Problem

You must enter the password for this forum.

" id=form2 name=form2> <% for each q in Request.QueryString Response.Write "" next %>

>Go Back To Enter Data

>Return to the forum

<% end sub sub doNotLoggedInForm() %>

There Was A Problem

You are not logged in.

>Go Back To Enter Data

>Return to the forum

<% Response.End end sub function getNewMemberNumber() dim my_Conn2 set my_Conn2 = Server.CreateObject("ADODB.Connection") my_Conn2.Open strConnString '## Forum_SQL strSql = "SELECT " & strMemberTablePrefix & "MEMBERS.MEMBER_ID " strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS " strSql = strSql & " WHERE " & strDBNTSQLName & " = '" & strDBNTUserName & "'" set rsGetMemberID = my_Conn2.Execute(strSql) if rsGetMemberID.EOF or rsGetMemberID.BOF then getNewMemberNumber = -1 exit function end if getNewMemberNumber = rsGetMemberID("MEMBER_ID") my_Conn2.Close Set my_Conn2 = nothing end function Function ReplaceUrls(fString) Dim oTag, c1Tag, c2Tag Dim roTag, rc1Tag, rc2Tag Dim oTagPos, c1TagPos, c2TagPos Dim nTagPos Dim counter2 Dim strArray, strArray2, strArray3 oTag = "[url=""" oTag2 = "[url]" roTag = "" c2Tag = "[/url]" rc2Tag = "" oTagPos = InStr(1, fString, oTag, 1) c1TagPos = InStr(1, fString, c1Tag, 1) strTempString = "" if (oTagpos > 0) and (c1TagPos > 0) then strArray = Split(fString, oTag, -1) for counter2 = 0 to UBound(strArray) if (InStr(1, strArray(counter2), c2Tag, 1) > 0) and (InStr(1, strArray(counter2), c1Tag, 1) > 0) then strArray2 = Split(strArray(counter2), c1Tag, -1) if Instr(1, strArray2(1), c2Tag) and not( (Instr(1, UCase(strArray2(1)), "[URL]") >0) and not(Instr(1, UCase(strArray2(1)), "[/URL]") >0) ) then ' if Instr(1, strArray2(1), c2Tag) then strFirstPart = Left(strArray2(1), Instr(1, strArray2(1),c2Tag)-1) strSecondPart = Right(strArray2(1), (Len(strArray2(1)) - Instr(1, strArray2(1), c2Tag) - len(c2Tag)+1)) if strFirstPart <> "" then if (Instr(strArray2(0),"@") > 0) and UCase(Left(strArray2(0), 7)) <> "MAILTO:" then strTempString = strTempString & roTag & "mailto:" & strArray2(0) & rc1Tag & strFirstPart & rc2Tag & strSecondPart else strTempString = strTempString & roTag & strArray2(0) & rc1Tag & strFirstPart & rc2Tag & strSecondPart end if else if (Instr(strArray2(0),"@") > 0) and UCase(Left(strArray2(0), 7)) <> "MAILTO:" then strTempString = strTempString & roTag & "mailto:" & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strSecondPart else strTempString = strTempString & roTag & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strSecondPart end if end if else strTempString = strTempString & roTag & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strArray2(1) end if elseif (InStr(1, strArray(counter2), c1Tag, 1) > 0) then strArray2 = Split(strArray(counter2), c1Tag, -1) strTempString = strTempString & roTag & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strArray2(1) else strTempString = strTempString & strArray(counter2) end if next else strTempString = fString end if oTagPos2 = InStr(1, strTempString, oTag2, 1) c1TagPos2 = InStr(1, strTempString, c1Tag2, 1) if (oTagpos2 > 0) and (c1TagPos2 > 0) then strTempString2 = "" strArray = Split(strTempString, oTag2, -1) for counter3 = 0 to Ubound(strArray) if (Instr(1, strArray(counter3), c1Tag2) > 0) then strArray2 = split(strArray(counter3), c1Tag2, -1) if (Instr(strArray2(0),"@") > 0) and UCase(Left(strArray2(0), 7)) <> "MAILTO:" then strTempString2 = strTempString2 & roTag & "mailto:" & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strArray2(1) else strTempString2 = strTempString2 & roTag & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strArray2(1) end if else strTempString2 = strTempString2 & strArray(counter3) end if next strTempString = strTempString2 end if ReplaceUrls = strTempString end function function isAllowedMember(fForum_ID,fMemberID) isAllowedMember = 0 on error resume next strSql = "SELECT MEMBER_ID, FORUM_ID FROM " & strMemberTablePrefix & "ALLOWED_MEMBERS " strSql = strSql & " WHERE " & strMemberTablePrefix & "ALLOWED_MEMBERS.FORUM_ID = " & fForum_ID strSql = strSql & " AND " & strMemberTablePrefix & "ALLOWED_MEMBERS.MEMBER_ID = " & fMemberID set rsAllowedMember = my_Conn.execute (strSql) if (rsAllowedMember.EOF or rsAllowedMember.BOF) then isAllowedMember = 0 exit function else isAllowedMember = 1 end if end function %>