![](" & web_site & "img/web.gif)
")
re.Pattern = "([A-Za-z0-9_\-\.]+@(\w+|\w+-\w+)\.[A-Za-z0-9_\.]+)"
encodeURL = re.replace(temp, "![](" & web_site & "img/mail.gif)
($1)")
End Function
Function UpdateList(action, catID, scatID, cat3rdID)
Select Case action
Case True: strOperator = "+ 1"
Case False: strOperator = "- 1"
End Select
catID = CLng(catID)
scatID = CLng(scatID)
cat3rdID = CLng(cat3rdID)
objConn.Execute("UPDATE " & tablPfx & "Cat SET ads = ads " & strOperator & " WHERE catID = " & catID & ";")
objConn.Execute("UPDATE " & tablPfx & "Scat SET ads = ads " & strOperator & " WHERE sCatID = " & scatID & ";")
If cat3rdID > 0 then objConn.Execute("UPDATE " & tablPfx & "Scat SET ads = ads " & strOperator & " WHERE catID = " & scatID & " AND sCatID = " & cat3rdID & ";")
End Function
Sub ExpireAds()
setLocale server_locale
On Error Resume Next
Dim uNick, uEmail
Select Case Application("Today_Expire_Flag" & strUnique)
Case Empty
Application("Today_Expire_Date" & strUnique) = Date
Application("Today_Expire_Flag" & strUnique) = "1"
ExpireAds
Case "1"
sdd = dd(objConn)
If mysql then
strSQL = "SELECT " & tablUPfx & "User.email," & tablPfx & "Ads.nick," & tablPfx & "Ads.catID," & tablPfx & "Ads.sCatID," & tablPfx & "Ads.adID," & tablPfx & "Ads.cat3rdID," & tablPfx & "Ads.subject FROM " & tablUPfx & "User," & tablPfx & "Ads WHERE "
strSQL = strSQL & "(" & tablPfx & "Ads.userID = " & tablUPfx & "User.userID AND " & tablPfx & "Ads.status = 1 AND " & tablPfx & "Ads.edate <= CURDATE()) LIMIT 0,1;"
Else
strSQL = "SELECT TOP 1 " & tablUPfx & "User.email," & tablPfx & "Ads.nick," & tablPfx & "Ads.catID," & tablPfx & "Ads.sCatID," & tablPfx & "Ads.adID," & tablPfx & "Ads.cat3rdID," & tablPfx & "Ads.subject FROM " & tablUPfx & "User," & tablPfx & "Ads WHERE "
strSQL = strSQL & "(" & tablPfx & "Ads.userID = " & tablUPfx & "User.userID AND " & tablPfx & "Ads.status = 1 AND " & tablPfx & "Ads.edate <= " & sdd & ConvDateShort(Date) & sdd & ");"
End If
set rsExp = objConn.Execute(strSQL)
If rsExp.EOF then
rsExp.close
Set rsExp = Nothing
If mysql then
strSQL = "SELECT ID,userID,keyword,email,unick,alertlist FROM " & tablPfx & "Agent WHERE (alertlist <> '') 0,1;"
Else: strSQL = "SELECT TOP 1 ID,userID,keyword,email,unick,alertlist FROM " & tablPfx & "Agent WHERE (alertlist <> '');"
End If
set rsalert = objConn.Execute(strSQL)
If Not rsalert.EOF then
ID = CLng(rsalert(0))
userID = rsalert(1)
alertKeys = rsalert(2)
email = CryptText(rsalert(3), key, True)
uNick = rsalert(4)
alertlist = Trim(rsalert(5))
rsalert.close
alertlistAllay = Split(alertlist)
For each adID in alertlistAllay
alertLinks = alertLinks & vbcrlf & web_site & "viewad.asp?id=" & adID
Next
template = getTemplate("Alerts", Empty, Empty, uNick, Empty, Empty)
uSubject = Split(template, s)(0)
uBody = Split(template, s)(1)
uBody = Replace(uBody, ":alertKeys:", alertKeys)
uBody = Replace(uBody, ":alertLinks:", alertLinks)
Call sendEmail(email, notify_email, uSubject, uBody)
strSQL = "UPDATE " & tablPfx & "Agent SET alertlist = '' WHERE ID = " & ID & ";"
objConn.Execute(strSQL)
Else
rsalert.close
Application("Today_Expire_Date" & strUnique) = Date + 1
Application("Today_Expire_Flag" & strUnique) = "0"
End If
Else
adID = rsExp(4)
objConn.Execute("UPDATE " & tablPfx & "Ads SET status = 2 WHERE adID = '" & adID & "';")
uEmail = CryptText(rsExp(0), key, True)
uNick = rsExp(1)
catID = rsExp(2)
subcatID = rsExp(3)
cat3rdID = rsExp(5)
subject = rsExp(6)
If isEvents then Call logEvent("Ad Expire", adID, subject, Empty, Empty, Empty)
Set rsExp = Nothing
Call UpdateList(False, catID, subcatID, cat3rdID)
template = getTemplate("Expired_Notification", Empty, Empty, uNick, Empty, adID)
uSubject = Split(template, s)(0)
uBody = Split(template, s)(1)
Call sendEmail(uEmail, notify_email, uSubject, uBody)
Application("cl_marquee" & strUnique) = Empty
rsExp.close
Set rsExp = Nothing
End If
Case "0"
If Application("Today_Expire_Date" & strUnique) <= Date then
Application("Today_Expire_Flag" & strUnique) = "1"
ExpireAds
End If
End Select
setLocale resetLocale
On Error Goto 0
End Sub
Function RotateBanner()
If Application("cl_rotator" & strUnique) = Empty then loadRotator
If Not Application("cl_rotator" & strUnique) = "0" then RotateBanner = rotate
End Function
Sub loadRotator()
strSQL = "SELECT ID,bname,altText FROM " & tablPfx & "Banner WHERE status = 1;"
set rsRot = objConn.Execute(strSQL)
If rsRot.EOF then
Application("cl_rotator" & strUnique) = 0: rsRot.close: Exit Sub
Else
Do while not rsRot.EOF
If Not rsRot.EOF then
strRotator = strRotator & vbCrLf & rsRot(0) & s & rsRot(1) & s & rsRot(2)
rsRot.MoveNext
End If
Loop
End If
rsRot.close
strRotator = ClearCarriageReturn(strRotator)
If Len(strRotator) > 5 then Application("cl_rotator" & strUnique) = strRotator: Else: Application("cl_rotator" & strUnique) = 0
End Sub
Function rotate()
On Error resume Next
setLocale server_locale
rDataArray = Split(Application("cl_rotator" & strUnique), vbCrLf)
r = Ubound(rDataArray) + 1
Randomize
rID = Int(r * Rnd)
banner = Split(rDataArray(rID), s)(1)
outID = Split(rDataArray(rID), s)(0)
altText = Split(rDataArray(rID), s)(2)
RotateString = "![](" & web_site & "img/mb.gif)
" & Replace(rsm(1), chr(34), "") & " "
strRemote = strRemote & "" & Replace(rsm(1), chr(34), "") & """+br+"""
rsm.MoveNext
Loop
strMarquee = strTemp
Application("cl_marquee" & strUnique) = strTemp
Else
strMarquee = "No Submissions"
Application("cl_marquee" & strUnique) = strMarquee
End If
If Len(strRemote) > 0 Then
strRemoteTicker = ""
writeFile Server.MapPath(upload) & "\feed.js", strRemoteTicker
End If
Else: strMarquee = Application("cl_marquee" & strUnique)
End If
End Function
Function HTMLEncode(text)
newtext = Replace(text, "<", "")
newtext = Replace(text, ">", "")
HTMLEncode = newtext
End Function
Function matchAlerts(adID, catID, scatID, cat3rdID, subject, body)
On Error Resume Next
catID = CLng(catID)
scatID = CLng(scatID)
If IsNumeric(cat3rdID) AND Len(CStr(cat3rdID)) > 1 then cat3rdID = CLng(cat3rdID): Else: cat3rdID = 0
strSQL = "SELECT " & tablPfx & "Agent.* FROM " & tablPfx & "Agent WHERE "
strSQL = strSQL & "(catID = " & catID & " AND scatID = " & scatID & " AND cat3rdID = " & cat3rdID & ")"
strSQL = strSQL & " OR (catID = " & catID & " AND scatID = " & 0 & ")"
strSQL = strSQL & " OR (catID = " & catID & " AND scatID = " & 0 & ")"
strSQL = strSQL & " OR (catID = " & 0 & " AND scatID = " & 0 & ");"
set rsa = objConn.Execute(strSQL)
If not rsa.EOF then
Do While Not rsa.EOF
ID = CLng(rsa(0))
stype = CLng(rsa(3))
keywords = rsa(2)
Select Case stype
Case 1
matchFound = False
keyArray = Split(keywords)
For each ikey in keyArray
If instr(1, subject, ikey, 1) <> 0 Or instr(1, body, ikey, 1) <> 0 Then matchFound = True: Exit For
Next
Case 2
matchFound = True
keyArray = Split(keywords)
For each ikey in keyArray
If instr(1, subject, ikey, 1) = 0 AND instr(1, body, ikey, 1) = 0 Then matchFound = False: Exit For
Next
Case 3
matchFound = False
If instr(1, subject, keywords, 1) <> 0 Or instr(1, body, keywords, 1) <> 0 Then matchFound = True
End Select
If matchFound Then
If not rsa(12) = Empty then straddAlert = "alertlist = alertlist + ' " & adID & "'" Else: straddAlert = " alertlist = ' " & adID & "'"
objConn.Execute("UPDATE " & tablPfx & "Agent SET " & straddAlert & " WHERE ID = " & ID & ";")
End If
rsa.MoveNext
Loop
End If
rsa.close
On Error Goto 0
End Function
Function ConvDate(passDate)
passDate = DateAdd("h", timeOffset, CDate(passDate))
ConvDate = DatePart("yyyy", passDate) & "-" & DatePart("m", passDate) & "-" & DatePart("d", passDate) & " " & DatePart("h", passDate) & ":" & DatePart("n", passDate) & ":" & DatePart("s", passDate)
End Function
Function ConvDateShort(passDate)
passDate = DateAdd("h", timeOffset, CDate(passDate))
ConvDateShort = DatePart("yyyy", passDate) & "-" & DatePart("m", passDate) & "-" & DatePart("d", passDate)
End Function
Sub checkIP(uIP)
If Len(uIP) > 5 then
If Not detectMultipleIP then Exit Sub
set rsIP = objConn.Execute("SELECT userID,nick,email FROM " & tablUPfx & "User WHERE IP='" & uIP & "';")
If not rsIP.EOF then
rsdata = rsIP.getrows
rsIP.close
numrows = UBound(rsdata,2) + 1
If numrows > 1 then
For m = 0 to UBound(rsdata,2)
strBodyx = strBodyx & vbcrlf & "User ID: " & rsdata(0, m) & ", User Nick: " & rsdata(1, m) & ", User Email: " & CryptText(rsdata(2, m), key, True)
Next
strBodyx = "Multiple accounts has possibly been created:" & vbcrlf & vbcrlf & strBodyx & vbcrlf & vbcrlf & "User Logged from: " & uIP & " to all of the above accounts."
strSubject = web_name & " - multiple account detected."
Call sendEmail(admin_email, admin_email, strSubject, strBodyx)
End If
Else: rsIP.close
End If
End If
End Sub
Sub build_Meta()
static_ads_keywords = "buy, sell"
On Error Resume Next
scr_Path = Request.ServerVariables("SCRIPT_NAME")
scr_Path_Array = Split(scr_Path, "/")
scr_Name = Lcase(scr_Path_Array(Ubound(scr_Path_Array)))
Select Case scr_Name
Case "viewscat.asp"
If IsNumeric(Request("id")) then
mcatID = Request("id")
set rscat = objConn.Execute("SELECT catFullDescr,catMetaDescr,catMetaKey,catTitle FROM " & tablPfx & "Cat WHERE catID = " & CLng(mcatID) & ";")
If not rscat.EOF then
full_description = rscat(0)
result_meta_description = rscat(1)
result_meta_keywords = rscat(2)
result_web_name = rscat(3)
End If
rscat.close
End If
Case "viewlist.asp"
on error goto 0
If IsNumeric(Request("cid")) and IsNumeric(Request("sid")) then
mscatID = Request("sid")
mcatID = Request("cid")
strSQL = "SELECT " & tablPfx & "Cat.catFullDescr," & tablPfx & "Cat.catMetaDescr," & tablPfx & "Cat.catMetaKey," & tablPfx & "Cat.catTitle,"
strSQL = strSQL & tablPfx & "Scat.scatFullDescr," & tablPfx & "Scat.scatMetaDescr," & tablPfx & "Scat.scatMetaKey," & tablPfx & "Scat.scatTitle, "
strSQL = strSQL & tablPfx & "Scat.scatName," & tablPfx & "Cat.catName "
strSQL = strSQL & "FROM " & tablPfx & "Cat, " & tablPfx & "Scat WHERE " & tablPfx & "Cat.catID = " & CLng(mcatID) & " AND " & tablPfx & "Scat.sCatID = " & CLng(mscatID) & ";"
set rscat = objConn.Execute(strSQL)
If not rscat.EOF then
full_description = rscat(4)
result_meta_description = rscat(5)
result_meta_keywords = rscat(6)
result_web_name = rscat(7)
catName = rscat(9)
subCatName = rscat(8)
If ((IsNull(result_web_name) OR Len(result_web_name) = 0) And default_to_cat) or Request("sa") = 1 then
full_description = rscat(0)
result_meta_description = rscat(1)
result_meta_keywords = rscat(2)
result_web_name = rscat(3)
End If
End If
rscat.close
End If
Case "viewsublist.asp"
If IsNumeric(Request("id")) then
mscat3rdID = Request("3id")
mcatID = Request("cid")
mscatID = Request("sid")
strSQL = "SELECT scatFullDescr,scatMetaDescr,scatMetaKey,scatTitle,scatName FROM " & tablPfx & "Scat WHERE catID = " & CLng(mscatID) & " AND sCatID = " & CLng(mscat3rdID) & ";"
set rscat = objConn.Execute(strSQL)
If not rscat.EOF then
full_description = rscat(0)
result_meta_description = rscat(1)
result_meta_keywords = rscat(2)
result_web_name = rscat(3)
cat3rdName = rscat(4)
If (IsNull(result_web_name) OR Len(result_web_name) = 0) And default_to_cat then
strSQL = "SELECT " & tablPfx & "Cat.catFullDescr," & tablPfx & "Cat.catMetaDescr," & tablPfx & "Cat.catMetaKey," & tablPfx & "Cat.catTitle,"
strSQL = strSQL & tablPfx & "Scat.scatFullDescr," & tablPfx & "Scat.scatMetaDescr," & tablPfx & "Scat.scatMetaKey," & tablPfx & "Scat.scatTitle "
strSQL = strSQL & "FROM " & tablPfx & "Cat, " & tablPfx & "Scat WHERE " & tablPfx & "Cat.catID = " & CLng(mcatID) & " AND " & tablPfx & "Scat.sCatID = " & CLng(mscatID) & ";"
set rscat = objConn.Execute(strSQL)
If not rscat.EOF then
full_description = rscat(4)
result_meta_description = rscat(5)
result_meta_keywords = rscat(6)
result_web_name = rscat(7)
If (IsNull(result_web_name) OR Len(result_web_name) = 0) And default_to_cat then
full_description = rscat(0)
result_meta_description = rscat(1)
result_meta_keywords = rscat(2)
result_web_name = rscat(3)
End If
End If
End If
End If
rscat.close
End If
Case "viewad.asp", "view_print.asp"
If IsNumeric(Request("id")) then
madID = Request("id")
strSQL = "SELECT subject,uopt8 FROM " & tablPfx & "Ads WHERE adID = '" & madID & "';"
set rsad = objConn.Execute(strSQL)
If not rsad.EOF then
msubject = rsad(0)
adStyle = rsad(1)
msubject = replace(msubject, ".", "")
msubject = replace(msubject, ",", "")
msubject = replace(msubject, "?", "")
msubject = replace(msubject, "!", "")
msubject = replace(msubject, ":", "")
result_web_name = msubject
result_meta_description = msubject
subject_array = Split(msubject)
For Each metakey in subject_array
If Len(metakey) > 2 then loose_key = loose_key & ", " & metakey
Next
mscatID = Left(madID, 5)
strSQL = "SELECT " & tablPfx & "Cat.catName, " & tablPfx & "Scat.scatName FROM "
strSQL = strSQL & tablPfx & "Cat, " & tablPfx & "Scat WHERE " & tablPfx & "Cat.catID = " & tablPfx & "Scat.catID AND " & tablPfx & "Scat.sCatID = " & CLng(mscatID) & ";"
set rsadc = objConn.Execute(strSQL)
If not rsadc.EOF then
mcatName = rsadc(0)
mscatName = rsadc(1)
End If
rsadc.close
If len(mcatName) > 0 then result_web_name = result_web_name & " - " & mcatName & " : " & mscatName
result_meta_keywords = static_ads_keywords & ", " & msubject & loose_key
If Len(adStyle) > 0 and uOpt(7) = "1" then dstyle = adStyle
End If
rsad.close
End If
Case "adpreview.asp"
adPreviewStyle = Request.Form("uO7")
If Len(adPreviewStyle) > 0 then dstyle = adPreviewStyle
End Select
If Len(result_web_name) = 0 or IsNull(result_web_name) then result_web_name = web_name
If IsNull(result_meta_description) OR Len(result_meta_description) = 0 then result_meta_description = meta_description
If IsNull(result_meta_keywords) OR Len(result_meta_keywords) = 0 then result_meta_keywords = meta_keywords
On Error goto 0
End Sub
Function BuildContent(contentType, topDisplay, box)
contentType = CLng(contentType)
topDisplay = CLng(topDisplay)
msgNoAds = ""
msgNoAccounts = ""
Select Case contentType
'### TOP HOT ADS
'----------------------------------------
Case 1
I = 1
If mysql then
strSQL = "SELECT subject, adID FROM " & tablPfx & "Ads WHERE (hotlist = 1 AND status = 1) ORDER BY pdate DESC LIMIT 0," & topDisplay & ";"
Else: strSQL = "SELECT TOP " & topDisplay & " subject, adID FROM " & tablPfx & "Ads WHERE (hotlist = 1 AND status = 1) ORDER BY pdate DESC;"
End If
set rs = objConn.Execute(strSQL)
If not rs.EOF then
strHot = "| " & title & " |
| " & title & " (" & rs(2) & ") " & strText_Hits & " |
| " & rs(1) & " (" & rs(2) & ") " & strText_Ads & " |
| " & title & " |
| " & title & " |
| " & strText_ExpandAll & " | " & strText_CollapseAll & " |
| "
strTree = strTree & " " strTree = strTree & " "
firstCatFound = True
End If
If currscatName <> scatNamet then
If Len(CStr(cat3rdIDt)) > 0 then strTree = strTree & " "
cat3rdIDt = Empty
newSubcat = True
scatNamet = currscatName
sCatIDt = rsdata(3,C)
If Len(displsCat) > 0 And displsCat = CStr(sCatIDt) then
scatStyle = "style='font-weight: bold;' "
Else: scatStyle = Empty
End If
sadst = rsdata(5,C)
strTree = strTree & " "
strTree = strTree & " " & scatNamet & " (" & sadst & ")" End If If Len(currcat3rdName) > 0 then cat3rdIDt = rsdata(6,C) c3adst = rsdata(8,C) If Len(displ3rdCat) > 0 And displ3rdCat = CStr(cat3rdIDt) then cat3Style = "style='font-weight: bold;' " Else: cat3Style = Empty End If If newSubcat then strTreeArray = strTreeArray & sCatIDt & "," If Len(displsCat) > 0 And displsCat = CStr(sCatIDt) then str3Display = "" cat3Img = "sm" Else str3Display = "display:none;" cat3Img = "s" End If strTree = strTree & " "
strTree = strTree & ""
End If
newSubcat = False
strTree = strTree & "  "
strTree = strTree & " " & currcat3rdName & " (" & c3adst & ")" End If Next strTree = strTree & " |