>> more"
end if
end function
function get_shoppinglinks(cat_id)
get_shoppinglinks = ""
getcat_name = replace(getcatname(cat_id), "&","")
getcat_name = replace(getcat_name, " ","")
SQL = "shopping_websitelist " & cat_id
rs1.Open SQL, objConn
If Not rs1.EOF Then
Do While Not rs1.EOF
get_shoppinglinks = get_shoppinglinks & "" & rs1("name") & ", "
rs1.MoveNext
Loop
end if
rs1.close
get_shoppinglinks = get_shoppinglinks & "
>> more"
end function
function getmylinks(cat_id, cat_name, uid)
getmylinks = ""
j=1
if cat_id=28 then
SQL = "SELECT url, name FROM link join vote on link.link_id=vote.linkid " & _
" join category on link.cat_id=category.cat_id " & _
" where category.parent_cat_id=28 and vote.uid=" & uid & " order by page_id, link.order_id "
else
SQL = "SELECT url, name FROM link join vote on link.link_id=vote.linkid " & _
" where vote.uid=" & uid & " and cat_id=" & cat_id & " order by page_id, order_id "
end if
rs1.Open SQL, objConn
If Not rs1.EOF Then
Do While Not rs1.EOF
if j=1 then
getmylinks = "
"
end if
rs1.close
end function
function editmylinks(cat_id, cat_name, uid)
editmylinks = ""
j=1
if cat_id=28 then
SQL = "SELECT url, name,link_id FROM link join vote on link.link_id=vote.linkid " & _
" join category on link.cat_id=category.cat_id " & _
" where category.parent_cat_id=28 and vote.uid=" & uid & " order by page_id, link.order_id "
else
SQL = "SELECT url, name,link_id FROM link join vote on link.link_id=vote.linkid " & _
" where vote.uid=" & uid & " and cat_id=" & cat_id & " order by page_id, order_id "
end if
rs1.Open SQL, objConn
If Not rs1.EOF Then
Do While Not rs1.EOF
if j=1 then
editmylinks = "
"
end if
j=j+1
rs1.MoveNext
Loop
editmylinks = editmylinks & ""
end if
rs1.close
end function
sub removevote(link_id, uid)
SQL = "delete from vote where linkid= " & link_id & " and uid=" & uid
set rsItem = objConn.execute(SQL)
end sub
function getfriendlinks(cat_id, cat_name, myuid)
dim sortarr(5,100), temparr(5,100)
getfriendlinks = ""
haslinks = "no"
j=0
if cat_id=28 then
SQL = "SELECT url, name, page_id, link.order_id, count(*) as count1 FROM myfriend f1 " & _
" join myfriend f2 on f1.friend_uid=f2.uid and f2.friend_uid=f1.uid " & _
" join vote on vote.uid=f1.uid " & _
" join link on link.link_id=vote.linkid " & _
" join category on link.cat_id=category.cat_id and category.parent_cat_id=28 " & _
" where f1.friend_uid="& myuid &" group by name, url, page_id, link.order_id "
else
SQL = "SELECT url, name, page_id, order_id, count(*) as count1 FROM myfriend f1 " & _
" join myfriend f2 on f1.friend_uid=f2.uid and f2.friend_uid=f1.uid " & _
" join vote on vote.uid=f1.uid " & _
" join link on link.link_id=vote.linkid " & _
" where cat_id=" & cat_id & " and f1.friend_uid="& myuid &" group by name, url, page_id, order_id "
end if
rs1.Open SQL, objConn
If Not rs1.EOF Then
Do While Not rs1.EOF
sortarr(0,j) = rs1("count1")
sortarr(1,j) = rs1("url")
sortarr(2,j) = rs1("name")
sortarr(3,j) = rs1("page_id")
sortarr(4,j) = rs1("order_id")
haslinks = "yes"
j=j+1
rs1.MoveNext
Loop
end if
rs1.close
num = j
if haslinks = "yes" then
For i = 0 To num - 2
For j = i To num-1
temp1 = sortarr(4,i)
temp2 = sortarr(4,j)
if temp1 > temp2 Then
For n=0 to 4
temparr(n,j) = sortarr(n,i)
sortarr(n,i) = sortarr(n,j)
sortarr(n,j) = temparr(n,j)
Next
End if
Next
Next
For i = 0 To num - 2
For j = i To num-1
temp1 = sortarr(3,i)
temp2 = sortarr(3,j)
if temp1 > temp2 Then
For n=0 to 4
temparr(n,j) = sortarr(n,i)
sortarr(n,i) = sortarr(n,j)
sortarr(n,j) = temparr(n,j)
Next
End if
Next
Next
For i = 0 To num - 2
For j = i To num-1
temp1 = sortarr(0,i)
temp2 = sortarr(0,j)
if temp1 < temp2 Then
For n=0 to 4
temparr(n,j) = sortarr(n,i)
sortarr(n,i) = sortarr(n,j)
sortarr(n,j) = temparr(n,j)
Next
End if
Next
Next
For j = 0 To num-1
if j=0 then
getfriendlinks = "
" & _
"" & cat_name & "
"
getfriendlinks = getfriendlinks & "" & sortarr(2,j) & ""
else
if j=7 then
getfriendlinks = getfriendlinks & ", " & sortarr(2,j) & ""
else
getfriendlinks = getfriendlinks & ", " & sortarr(2,j) & ""
end if
end if
Next
getfriendlinks = getfriendlinks & "
"
end if
end function
function getlinks1(cat_id)
j= 0
getlinks1 = ""
SQL = "SELECT * FROM link where page_id=2 and cat_id=" & cat_id & " order by order_id "
rs1.Open SQL, objConn
If Not rs1.EOF Then
Do While Not rs1.EOF
j = j+1
if j=1 then
getlinks1 = getlinks1 & "
" & rs1("name") & ""
end if
rs1.MoveNext
Loop
else
getlinks1 = " "
end if
rs1.Close
getlinks1 = getlinks1 & "
"
end function
function getlinks2(cat_id)
getlinks2 = ""
num =0
SQL = "SELECT * FROM link where cat_id=" & cat_id & " order by page_id, order_id"
rs.Open SQL, objConn
If Not rs.EOF Then
Do While Not rs.EOF
if num mod 5 =0 then
getlinks2 = getlinks2 & "
"
end if
num = num +1
rs.MoveNext
Loop
end if
rs.Close
end function
function gettop10(cat_id)
gettop10 = ""
num =1
SQL = "SELECT * FROM link where cat_id=" & cat_id & " order by page_id, order_id "
rs.Open SQL, objConn
If Not rs.EOF Then
Do While Not rs.EOF
if num<11 then
gettop10 = gettop10 & "
"
end if
num = num +1
rs.MoveNext
Loop
end if
rs.Close
end function
function isUserExist(emailaddress)
isUserExist = "no"
SQL = "select * from users where email ='" & trim(emailaddress) & "' "
rs.Open SQL, objConn
If Not rs.EOF Then
isUserExist = "yes"
end if
rs.Close
end function
function getPasswordByEmail(emailaddress)
getPasswordByEmail = ""
SQL = "select password from users where email ='" & trim(emailaddress) & "' "
rs.Open SQL, objConn
If Not rs.EOF Then
getPasswordByEmail = rs("password")
end if
rs.Close
end function
sub sendemail(emailaddress, ipaddress)
Set myMail=CreateObject("CDO.Message")
myMail.Subject="Your Password at getMyBest.com"
myMail.From=emailaddress
myMail.To= emailaddress
myMail.TextBody="Your Password at getMyBest.com is: " & getPasswordByEmail(emailaddress) & vbCrLf & vbCrLf & _
"This request is from IP: " & ipaddress
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing")=2
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") ="mail.getmybest.com"
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") =1
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") ="support@getmybest.com"
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") ="r8rlian"
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") =25
myMail.Configuration.Fields.Update
myMail.Send
set myMail=nothing
end sub
sub addemaillog(emailaddress, ipaddress)
rs.Open "emaillog", objConn, adOpenForwardOnly, adLockOptimistic, adCmdTable
rs.AddNew
rs("emailaddress") = sqlizestr(trim(emailaddress))
rs("requesttime") = now()
rs("ipaddress") = sqlizestr(trim(ipaddress))
rs.update
rs.Close
end sub
function isemailsent(emailaddress, ipaddress)
isemailsent = "no"
SQL = "select * from emaillog where emailaddress ='" & trim(emailaddress) & "' order by requesttime desc "
rs.Open SQL, objConn
If Not rs.EOF Then
if DateDiff("d",FormatDateTime(rs("requesttime"),2),Date)<2 then
isemailsent = "yes"
end if
end if
rs.Close
end function
function isFriendExist(emailaddress, uid)
isFriendExist = "no"
SQL = "select * from myfriend join users on friend_uid=id where Email ='" & trim(emailaddress) & "' and uid= " & uid
rs.Open SQL, objConn
If Not rs.EOF Then
isFriendExist = "yes"
end if
rs.Close
end function
function isVoteExist(linkid, uid)
isVoteExist = "no"
SQL = "select ID from vote where linkid =" & linkid & " and uid= " & uid
rs.Open SQL, objConn
If Not rs.EOF Then
isVoteExist = "yes"
end if
rs.Close
end function
sub deletefriend(fid, uid)
SQL = "delete from myfriend where fid= " & fid & " and uid=" & uid
set rsItem = objConn.execute(SQL)
end sub
function checkUser(emailaddress,password)
checkUser = "no"
SQL = "select * from users where email ='" & emailaddress & "' and password= '" & password & "' "
rs.Open SQL, objConn
If Not rs.EOF Then
checkUser = "exist"
session("uid") = rs("id")
session("uaddress") = rs("email")
end if
rs.Close
end function
function getUserID(emailaddress)
SQL = "select id from users where email ='" & emailaddress & "' "
rs1.Open SQL, objConn
If Not rs1.EOF Then
getUserID = rs1("id")
end if
rs1.Close
end function
sub addfriend(uid, name, emailaddress)
rs.Open "myfriend", objConn, adOpenForwardOnly, adLockOptimistic, adCmdTable
rs.AddNew
rs("uid") = uid
rs("friend_uid") = getUserID(sqlizestr(trim(emailaddress)))
rs("friend_name") = sqlizestr(trim(name))
rs.update
rs.Close
end sub
sub adduser(firstname, lastname, email, password, Agree_Terms, ipaddress)
rs.Open "users", objConn, adOpenForwardOnly, adLockOptimistic, adCmdTable
rs.AddNew
rs("lastname") = sqlizestr(trim(lastname))
rs("firstname") = sqlizestr(trim(firstname))
rs("email") = sqlizestr(trim(email))
rs("password") = trim(password)
rs("isActive") = 1
rs("createdate") = now()
rs("ipaddress") = ipaddress
rs("Agree_Terms") = sqlizebit(Agree_Terms)
rs.update
rs.Close
end sub
sub updateuser(uid,ischecked)
SQL = "update users set PermitFriendView=" & sqlizebit(ischecked) & " where id=" & uid
set rsItem = objConn.execute(SQL)
end sub
sub updateuserinfo(firstname, lastname, password, changepassword, uaddress)
if changepassword = "yes" then
SQL = "update users set firstname='" & sqlizestr(firstname) & "', lastname='" & sqlizestr(lastname) & "', [Password]='" & sqlizestr(password) & "' where email='" & uaddress & "' "
else
SQL = "update users set firstname='" & sqlizestr(firstname) & "', lastname='" & sqlizestr(lastname) & "' where email='" & uaddress & "' "
end if
'response.write SQL
'response.end
set rsItem = objConn.execute(SQL)
end sub
sub loguser(emailaddress, ipaddress)
SQL = "update users set LastLogin='" & now() & "', LastLogin_IP='" & sqlizestr(ipaddress) & "' where email='" & emailaddress & "' "
set rsItem = objConn.execute(SQL)
end sub
function getallcat()
getallcat = ""
SQL = "SELECT * FROM category where parent_cat_id=0 and cat_id<>57 and cat_id<>58 and cat_id<>59 order by cat_name"
rs.Open SQL, objConn
If Not rs.EOF Then
Do While Not rs.EOF
getcat_name=rs("cat_name")
getcat_name = replace(getcat_name, "&","")
getcat_name = replace(getcat_name, " ","")
if rs("cat_id") = 28 then
getallcat = getallcat & "
"
end if
rs.MoveNext
Loop
end if
rs.Close
end function
function getallcat_shopping()
getallcat_shopping = ""
SQL = "SELECT * FROM category where parent_cat_id=0 and cat_id<>57 and cat_id<>58 and cat_id<>59 order by cat_name"
rs.Open SQL, objConn
If Not rs.EOF Then
Do While Not rs.EOF
getcat_name=rs("cat_name")
getcat_name = replace(getcat_name, "&","")
getcat_name = replace(getcat_name, " ","")
if rs("cat_id") = 28 then
getallcat_shopping = getallcat_shopping & "
"
end if
rs.MoveNext
Loop
end if
rs.Close
end function
function gettools(cat_id)
gettools = ""
j=0
SQL = "SELECT * FROM link where cat_id=" & cat_id & " order by order_id"
rs1.Open SQL, objConn
If Not rs1.EOF Then
Do While Not rs1.EOF
if j mod 2 =0 then
gettools = gettools & "
"
end if
j= j+1
rs1.MoveNext
Loop
end if
rs1.close
end function
function voteit(linkid,cat_id, get_cat_name, uid)
voteit = ""
getcat_name1 = replace(getcatname(cat_id), "&","")
getcat_name1 = replace(getcat_name, " ","")
SQL = " SELECT * FROM vote where linkid= " & linkid & " and uid=" & uid
rs1.Open SQL, objConn
if rs1.EOF then
voteit = ", Vote"
end if
rs1.close
end function
function totalvote(linkid)
totalvote = 0
SQL = " select count(*) as tnum FROM vote where linkid= " & linkid
rs1.Open SQL, objConn
if not rs1.EOF then
totalvote = rs1("tnum")
end if
rs1.close
end function
function addvote(linkid,uid, userip)
rs.Open "vote", objConn, adOpenForwardOnly, adLockOptimistic, adCmdTable
rs.AddNew
rs("linkid") = linkid
rs("vote") = 1
rs("uid") = uid
rs("votetime") = now()
rs("voteip") = userip
rs.update
rs.Close
end function
function addlink(catid, title, description, keyword, url, userip)
rs.Open "templink", objConn, adOpenForwardOnly, adLockOptimistic, adCmdTable
rs.AddNew
rs("title") = title
rs("description") = sqlizestr(description)
rs("keyword") = sqlizestr(keyword)
rs("url") = url
rs("createdtime") = now()
rs("cat") = catid
rs("listingip") = userip
rs.update
rs.Close
end function
function addsuggestion(description, userip)
rs.Open "suggestion", objConn, adOpenForwardOnly, adLockOptimistic, adCmdTable
rs.AddNew
rs("description") = sqlizestr(description)
rs("createdtime") = now()
rs("userip") = userip
rs.update
rs.Close
end function
function getcatname(cat_id)
getcatname = ""
SQL = "SELECT * FROM category where cat_id=" & cat_id
rs2.Open SQL, objConn
If Not rs2.EOF Then
getcatname = rs2("cat_name")
end if
rs2.Close
end function
function hassubcat(cat_id)
hassubcat = "no"
SQL = "SELECT * FROM category where parent_cat_id=" & cat_id
rs.Open SQL, objConn
If Not rs.EOF Then
hassubcat = "yes"
end if
rs.Close
end function
function subcatlist(cat_id)
subcatlist = ""
end function
function getcat(catid)
SQL = " select * from category where parentcat_id= " & catid
rs.Open SQL, objConn
if not rs.EOF then
Do While Not rs.EOF
getcat = getcat & "" &rs("cat_description") & " "
rs.MoveNext
Loop
end if
rs.close
end function
function getlinks11(cat_id)
getlinks11 = ""
num =0
SQL = "SELECT * FROM link where page_id=2 and cat_id=" & cat_id
rs.Open SQL, objConn
If Not rs.EOF Then
Do While Not rs.EOF
num = num +1
if num=1 then
getlinks11 = "
"
elseif num=7 or num=13 or num=19 or num=25 or num=31 or num=37 or num=43 or num=49 or num=55 then
getlinks11 = getlinks11 & "
"
end if
rs.close
end function
function GetHTTPRequest(addr)
dim obj
set obj=Server.CreateObject("Msxml2.ServerXMLHTTP")
obj.setTimeouts 80000, 80000, 80000, 80000
obj.open "GET", addr
obj.send
if ((obj.Status>=400) and (obj.Status<=599)) then
GetHTTPRequest="Error Occurred : " & obj.Status & " - " & obj.statusText
else
GetHTTPRequest=obj.ResponseText
end if
set obj=nothing
end function
function GetTagValue(html, tag)
Dim expressionmatch, expressionmatched, RegExpObject, value
set RegExpObject = New RegExp
With RegExpObject
.Pattern = "<[\s]*" & tag & "[\s]*[^>]*>[^>]*"
.IgnoreCase = true
.Global = True
End With
set expressionmatch = RegExpObject.Execute(html)
For Each expressionmatched in expressionmatch
value = GetInnerText(expressionmatched.value)
Exit For
Next
GetTagValue = value
end function
function GetInnerText(tag)
Dim expressionmatch, expressionmatched, RegExpObject, value
set RegExpObject = New RegExp
With RegExpObject
.Pattern = ">[^<]*", "")
value = replace(value, "]*" & the_attribute & "=""" & value & """[^>]*>"
.IgnoreCase = true
.Global = True
End With
set expressionmatch = RegExpObject.Execute(html)
For Each expressionmatched in expressionmatch
val = expressionmatched.value
'response.Write "
it is " & Server.HTMLEncode(val)
Exit For
Next
GetTagValueWithAttribute = val
end function
function GetAttribute(tag, the_attribute)
Dim expressionmatch, expressionmatched, RegExpObject, value
set RegExpObject = New RegExp
With RegExpObject
.Pattern = the_attribute & "=""[^""]*"""
.IgnoreCase = true
.Global = True
End With
set expressionmatch = RegExpObject.Execute(tag)
For Each expressionmatched in expressionmatch
value = expressionmatched.value
Exit For
Next
GetAttribute = GetValBetweenQuotes(value)
end function
function GetValBetweenQuotes(str)
Dim expressionmatch, expressionmatched, RegExpObject, value
set RegExpObject = New RegExp
With RegExpObject
.Pattern = """[^""]*"""
.IgnoreCase = true
.Global = True
End With
set expressionmatch = RegExpObject.Execute(str)
For Each expressionmatched in expressionmatch
value = expressionmatched.value
value = replace(value, """", "")
Exit For
Next
GetValBetweenQuotes = value
end function
function limitstr(str,limitnum,keyword)
dim str1,str2,str3, fixlen
fixlen = limitnum
if len(str)>fixlen then
str1= left(str,fixlen)
str2 = right(str,(len(str)-fixlen))
str3 = left(str2,instr(str2," "))
if str3="" then
limitstr = str
else
limitstr = str1 & str3
end if
else
limitstr = str
end if
'limitstr = trim(limitstr)
if len(limitstr)>limitnum then
limitstr = trimend(limitstr)
limitstr = trimend(limitstr)
limitstr = limitstr & " ..."
end if
if len(trim(limitstr))>0 then
limitstr = limitstr & " "
end if
end function
function limitstrincat(str,limitnum,keyword,cat_id)
dim str1,str2,str3, fixlen
fixlen = limitnum
if len(str)>fixlen then
str1= left(str,fixlen)
str2 = right(str,(len(str)-fixlen))
str3 = left(str2,instr(str2," "))
if str3="" then
limitstrincat = str
else
limitstrincat = str1 & str3
end if
else
limitstrincat = str
end if
'limitstr = trim(limitstr)
if len(limitstrincat)>limitnum then
limitstrincat = trimend(limitstrincat)
limitstrincat = trimend(limitstrincat)
limitstrincat = limitstrincat & " ..."
end if
if len(trim(limitstrincat))>0 then
limitstrincat = limitstrincat & " "
end if
end function
function trimend(str)
trimend =str
if right(str,1)=" " or right(str,1)="," or right(str,1)="|" or right(str,1)=";" or right(str,1)="?" or right(str,1)="-" or right(str,1)="." or right(str,1)="&" or right(str,1)=":" then
trimend = left(str,len(str)-1)
end if
end function
function formaturl(url)
url1 = replace(url,"http://","")
formaturl = "" & url1 & ""
end function
function showcategories(cat_id)
showcategories = "