<%
strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath("./data.mdb")
SET objDBCon = Server.CreateObject("ADODB.Connection")
objDBCon.open strConnect
if not isempty(request.form("login")) then
Set checkName = objDBCon.Execute("SELECT ID FROM tblsUsers WHERE userName = '" & checkMess(request.form("name")) & "'")
if checkName.EOF then
theMess = "The user name (" & request.form("name") & ") you submitted could not be found in the data base, please try again"
else
Set checkPass = objDBCon.Execute("SELECT accLevel, email, fullName FROM tblsUsers WHERE password = '" & checkMess(request.form("password")) & "' AND ID =" & checkName("ID"))
if checkPass.EOF then
theMess = "Sorry this submitted password does not match the login ID, please try again"
else
session("SessUserName") = checkPass("fullname")
session("SessUserID") = checkName("ID")
session("sessionEmail") = checkPass("email")
session("sessionAccLevel") = checkPass("accLevel")
objDBCon.Execute("UPDATE tblsUsers SET lastLogged = '" & now() & "' WHERE ID = " & checkName("ID"))
postIT = 1
end if
end if
end if
%>
<%
function checkMess(Mess)
dim i, mess2
Mess = trim(Mess)
if len(Mess) = 0 then
checkMess = " "
exit function
end if
Mess2 = ""
for i = 1 to len(Mess)
if mid(Mess,i,1) = "'" then
Mess2 = Mess2 & "''"
else
Mess2 = Mess2 & mid(Mess,i,1)
end if
next
checkMess = Mess2
end function
function chkEmail(theAddress)
dim atCnt
chkEmail = theAddress
if len(theAddress) < 5 then
chkEmail = 1
elseif instr(theAddress,"@") = 0 then
chkEmail = 1
elseif instr(theAddress,".") = 0 then
chkEmail = 1
elseif len(theAddress) - instrrev(theAddress,".") > 3 then
chkEmail = 1
elseif instr(theAddress,"_") <> 0 and _
instrrev(theAddress,"_") > instrrev(theAddress,"@") then
chkEmail = 1
else
atCnt = 0
for i = 1 to len(theAddress)
if mid(theAddress,i,1) = "@" then
atCnt = atCnt + 1
end if
next
if atCnt > 1 then
chkEmail = 1
end if
for i = 1 to len(theAddress)
if not isnumeric(mid(theAddress,i,1)) and _
(lcase(mid(theAddress,i,1)) < "a" or _
lcase(mid(theAddress,i,1)) > "z") and _
mid(theAddress,i,1) <> "_" and _
mid(theAddress,i,1) <> "." and _
mid(theAddress,i,1) <> "@" and _
mid(theAddress,i,1) <> "-" then
chkEmail = 1
end if
next
end if
end function
strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath("./data.mdb")
SET objDBCon = Server.CreateObject("ADODB.Connection")
objDBCon.open strConnect
Set getApp = objDBCon.Execute("SELECT * FROM tblsSetup")
function filterLan(messStr)
Set checkLanOn = objDBCon.Execute("SELECT langFilter FROM tblsSetup")
If checkLanOn("langFilter") = "True" then
Set getLan = objDBCon.Execute("SELECT filterWord FROM tblsLan")
Do Until getLan.EOF
setCount = inStr(1,messStr, getLan("filterWord"),1)
Do Until setCount = 0
midRep = ""
startRep = left(getLan("filterWord"),1)
endRep = right(getLan("filterWord"),1)
midRepCount = len(getLan("filterWord")) - 2
Do Until i = midRepCount
midRep = midRep & "*"
i = i + 1
Loop
I = 0
word = startRep & midRep & endRep
messStr = replace(messStr, getLan("filterWord"), word,1, -1, 1)
getLan.MoveNext
Q = Q + 1
if getLan.EOF then
Set getLan = nothing
filterLan = checkMess(messStr)
Exit Function
end if
setCount = inStr(1,messStr, getLan("filterWord"),1)
Loop
GetLan.MoveNext
Loop
Set getLan = nothing
filterLan = messStr
end if
Set checkLanOn = nothing
filterLan = messStr
end function
function getNext10(num)
pageLen = len(num)
if pageLen = 1 then
next10 = 10
elseif pageLen = 2 then
pageRem = 10
pageTen = right(num, 1)
next10 = num + pageRem - pageTen
elseif pageLen > 2 then
pageRem = 10
pageTen = right(num, 1)
next10 = num + pageRem - pageTen
end if
getNext10 = next10
end function
function getPrev10(num)
pageLen = len(num)
if pageLen = 1 then
prev10 = 1
elseif pageLen = 2 then
firstDig = left(num, 1)
secondDig = right(num, 1)
prev10 = num - secondDig - 10
elseif pageLen > 2 then
firstDig = right(num, 2)
secondDig = right(num, 1)
prev10 = num - secondDig - 10
end if
if prev10 = 0 then
prev10 = 1
end if
getPrev10 = prev10
end function
function createMonth(str, timeStr)
Dim arrMth(12)
arrMth(1) = "January"
arrMth(2) = "Febuary"
arrMth(3) = "March"
arrMth(4) = "April"
arrMth(5) = "May"
arrMth(6) = "June"
arrMth(7) = "July"
arrMth(8) = "August"
arrMth(9) = "September"
arrMth(10) = "October"
arrMth(11) = "November"
arrMth(12) = "December"
if timeStr = "NW" then
createMonth = arrMth(Str)
elseif timeStr = "NX" then
createMonth = str + 1
elseif timeStr = "PR" then
createMonth = str - 1
end if
End function
function parseCode(parsingStr)
Dim parserStrs(11) ' Array for style parsing
parserStrs(0) = Array("[b]","","[/b]","")
parserStrs(1) = Array("[i]","","[/i]","")
parserStrs(2) = Array("[h1]","","[/h1]","
")
parserStrs(3) = Array("[h2]","","[/h2]","
")
parserStrs(4) = Array("[h3]","","[/h3]","
")
parserStrs(5) = Array("[h4]","","[/h4]","
")
parserStrs(6) = Array("[h5]","","[/h5]","
")
parserStrs(7) = Array("[h6]","","[/h6]","
")
parserStrs(8) = Array("[ul]","","[/ul]","")
parserStrs(9) = Array("[center]","","[/center]","
")
parserStrs(10) = Array("[left]","","[/left]","
")
parserStrs(11) = Array("[right]","","[/right]","
")
parserStrs(7) = Array("[blockquote]","","[/blockquote]","
")
Dim setStrs(2) ' Array for advanced parsing
setStrs(0) = Array("[url]", "[/url]")
setStrs(1) = Array("[url=","[/url]","]")
Do Until IDx = uBound(parserStrs) + 1
If inStr(lCase(parsingStr),parserStrs(IDx)(0)) + inStr(lCase(parsingStr),parserStrs(IDx)(2)) > 0 AND inStr(lCase(parsingStr),parserStrs(IDx)(0)) < inStr(lCase(parsingStr),parserStrs(IDx)(2)) then
count = inStr(lCase(parsingStr),parserStrs(IDx)(0)) + inStr(lCase(parsingStr),parserStrs(IDx)(2))
Do Until count = 0 OR count = inStr(lCase(parsingStr),parserStrs(IDx)(0)) OR count = inStr(lCase(parsingStr),parserStrs(IDx)(2))
startPos = inStr(lCase(parsingStr), parserStrs(IDx)(0))
endPos = inStr(startPos, lCase(parsingStr), parserStrs(IDx)(2)) + len(parserStrs(IDx)(2)) - 1
test = mid(parsingStr, startPos, endPos)
test2 = replace(test,parserStrs(IDx)(0), parserStrs(IDx)(1),1,1,1)
test2 = replace(test2,parserStrs(IDx)(2), parserStrs(IDx)(3),1,1,1)
parsingStr = replace(parsingStr,test, test2,1,1,1)
count = 0
count = inStr(parsingStr,parserStrs(IDx)(0)) + inStr(parsingStr,parserStrs(IDx)(2))
Loop
end if
IDx = IDx + 1
Loop
' Links
If inStr(lCase(parsingStr),setStrs(1)(0)) + inStr(lCase(parsingStr),setStrs(1)(1)) + inStr(lCase(parsingStr),setStrs(1)(2)) > 0 AND inStr(lCase(parsingStr),setStrs(1)(0)) AND inStr(lCase(parsingStr),setStrs(1)(2)) < inStr(lCase(parsingStr),setStrs(1)(1)) then
count = inStr(lCase(parsingStr),setStrs(1)(0)) + inStr(lCase(parsingStr),setStrs(1)(1)) + inStr(lCase(parsingStr),setStrs(1)(2))
Do Until count = 0 OR count = inStr(lCase(parsingStr),setStrs(1)(0)) OR count = inStr(lCase(parsingStr),setStrs(1)(1)) OR count = inStr(lCase(parsingStr),setStrs(1)(2)) OR count = inStr(lCase(parsingStr),setStrs(1)(1)) + inStr(lCase(parsingStr),setStrs(1)(2)) OR count = inStr(lCase(parsingStr),setStrs(1)(0)) + inStr(lCase(parsingStr),setStrs(1)(2)) OR count = inStr(lCase(parsingStr),setStrs(1)(1)) + inStr(lCase(parsingStr),setStrs(1)(0))
startPos = inStr(lCase(parsingStr),setStrs(1)(0))
endPos = inStr(startPos,lCase(parsingStr),setStrs(1)(1)) + len(setStrs(1)(1))
getString = mid(parsingStr, startPos, endPos - startPos)
endPosSec = inStr(lCase(getString),setStrs(1)(2))
getText2 = mid(parsingStr, startPos, endPosSec - 1)
If inStr(lCase(getText2), "http://") then getText2 = replace(getText2, "http://", "", 1,1,1)
endPos = inStr(lCase(getString),setStrs(1)(1))
lnkTxt = mid(getString, endPosSec + 1, inStr(lCase(getString),setStrs(1)(1)) - endPosSec - 1)
repStr1 = "" & lnkTxt & ""
repStr1 = replace(repStr1,setStrs(1)(0),"",1,1,1)
repStr1 = replace(repStr1,setStrs(1)(1),"",1,1,1)
repStr1 = replace(repStr1,setStrs(1)(2),"",1,1,1)
repStr1 = replace(repStr1,setStrs(1)(2),"",1,1,1)
parsingStr = replace(parsingStr, getString, repStr1, 1, 1, 1)
count = inStr(lCase(parsingStr),setStrs(1)(0)) + inStr(lCase(parsingStr),setStrs(1)(1)) + inStr(lCase(parsingStr),setStrs(1)(2))
Loop
end if
If inStr(lCase(parsingStr),setStrs(0)(0)) + inStr(lCase(parsingStr),setStrs(0)(1)) > 0 AND inStr(lCase(parsingStr),setStrs(0)(0)) < inStr(lCase(parsingStr),setStrs(0)(1)) then
count = inStr(lCase(parsingStr),setStrs(0)(0)) + inStr(lCase(parsingStr),setStrs(0)(1))
Do Until count = 0 OR count = inStr(lCase(parsingStr),setStrs(0)(0)) OR count = inStr(lCase(parsingStr),setStrs(0)(1))
startPos = inStr(lCase(parsingStr),setStrs(0)(0))
endPos = inStr(lCase(parsingStr),setStrs(0)(1)) + len(setStrs(0)(1))
getString = mid(parsingStr,startPos, endPos - startPos)
getText = mid(parsingStr,startPos, endPos - startPos)
getText = replace(getText,setStrs(0)(0),"",1,1,1)
getText = replace(getText,setStrs(0)(1),"",1,1,1)
If inStr(lCase(getText), "http://") then getText = replace(getText, "http://", "", 1,1,1)
repStr1 = "" & getText & ""
parsingStr = replace(parsingStr, getString, repStr1, 1, 1, 1)
count = inStr(lCase(parsingStr),setStrs(0)(0)) + inStr(lCase(parsingStr),setStrs(0)(1))
Loop
end if
parseCode = smileParse(parsingStr)
end function
' Smilies
Function smileParse(smileStr)
smileParse = smileStr
Dim smileArray(33)
smileArray(0) = Array(":)","1.gif")
smileArray(1) = Array(":D","2.gif")
smileArray(2) = Array(";)","3.gif")
smileArray(3) = Array(":o","4.gif")
smileArray(4) = Array("[sure]","5.gif")
smileArray(5) = Array("[winking]","3b.gif")
smileArray(6) = Array(":p","6.gif")
smileArray(7) = Array("[glasses]","7.gif")
smileArray(8) = Array("[rolleyes]","8.gif")
smileArray(9) = Array(":(","9.gif")
smileArray(10) = Array("[evilmad]","10.gif")
smileArray(11) = Array("[evilsmile]","11.gif")
smileArray(12) = Array("[hmm]","12.gif")
smileArray(13) = Array("[angel]","13.gif")
smileArray(14) = Array("[santa]","14.gif")
smileArray(15) = Array("[bday]","15.gif")
smileArray(16) = Array("[mad]","16.gif")
smileArray(17) = Array("[borg]","17.gif")
smileArray(18) = Array("[confused]","18.gif")
smileArray(19) = Array("[strange]","19.gif")
smileArray(20) = Array("[hell]","20.gif")
smileArray(21) = Array("[fro]","21.gif")
smileArray(22) = Array("[cake]","22.gif")
smileArray(23) = Array("[rofl]","23.gif")
smileArray(24) = Array("[letitout]","24.gif")
smileArray(25) = Array("[love]","25.gif")
smileArray(26) = Array("[nurse]","26.gif")
smileArray(27) = Array("[shock]","27.gif")
smileArray(28) = Array("[sleep]","28.gif")
smileArray(29) = Array("[rambo]","29.gif")
smileArray(30) = Array("[thumbup]","30.gif")
smileArray(31) = Array("[lol]","31.gif")
smileArray(32) = Array("[chicken]","32.gif")
smileArray(33) = Array("[smokin]","33.gif")
I = 0
Do Until I = uBound(smileArray) + 1
replaceStr = "![]()
"
smileParse = replace(smileParse,smileArray(I)(0),replaceStr,1,-1,1)
I = I + 1
Loop
smileParse = changeImg(smileParse)
end function
Function countImgs(countStr)
continue = "True"
startPos = 1
Do Until continue = "False"
If inStr(startPos, lCase(countStr),"[img name=") then
countImgs = countImgs + 1
startPos = inStr(startPos, lCase(countStr),"[img name=") + len("[img name=")
else
continue = "False"
end if
Loop
end function
Function changeImg(changeStr)
If inStr(lCase(changeStr),"[img name=") + inStr(lCase(changeStr),"]") > 0 then
count = inStr(lCase(changeStr),"[img name=") + inStr(lCase(changeStr),"]")
Do Until count = 0 OR count = inStr(lCase(changeStr),"[img name=") OR count = inStr(lCase(changeStr),"]")
startPos = inStr(lCase(changeStr), "[img name=")
endPos = inStr(startPos, lCase(changeStr), "]") + 1
getImgStr = mid(changeStr, startPos, endPos - startPos)
getImgStart = inStr(getImgStr, "=") + 1
getImgEnd = inStr(getImgStr, "]")
getImgName = mid(getImgStr, getImgStart, getImgEnd - getImgStart)
ImgStr = "![]()
"
changeStr = replace(changeStr, getImgStr, imgStr,1,1,1)
count = inStr(lCase(changeStr),"[img name=") + inStr(lCase(changeStr),"]")
Loop
End if
changeImg = filterLan(changeStr)
end function
' There is a regular expression version more most of these functions. If you want them, Email us at regexp@e4ums.com :o)
%>
<%
response.write("" & chr(13) _
& "" & chr(13) _
& "" & chr(13) _
& " Log in" & chr(13) _
& "" & chr(13))
If postIT = 1 then
response.write("" & chr(13) _
& "Thank you for logging in " & session("SessUserName") & "
You Will be redirected shortly
Click to go now" & chr(13))
response.end
end if
response.write("" & chr(13) _
& "
" & chr(13) _
& theMess & chr(13) _
& "" & chr(13) _
& "" & chr(13) _
& "