| Author |
 Topic  |
|
MaGraham
Senior Member
USA
1297 Posts |
 Posted - 28 May 2013 : 00:18:14
|
Would it be difficult for the "Friends Mod" to display the members' avatar instead of their usernames. . .or even better, in addition to their username?
You know how it is, a picture is much quicker for the brain to distinguish rather than for the eyes to take time to read. That's the reason there's a girl/boy graphic on restroom signs! 
|
"Do all the good you can, by all the means you can, in all the ways you can, at all the times you can, to all the people you can, as long as ever you can." - John Wesley |
|
|
Carefree
Advanced Member
Philippines
4217 Posts |
Posted - 01 June 2013 : 11:53:17
|
Not difficult, no. Here's one method:
"pop_profile.asp"
|
Edited by - Carefree on 01 June 2013 11:54:17 |
 |
|
|
MaGraham
Senior Member
USA
1297 Posts |
Posted - 01 June 2013 : 12:19:35
|
Oh wow! That worked! How easy!
Could the members' avatars be a little smaller though. . .and could we remove the comma?
I know; I'm PICKY!
|
"Do all the good you can, by all the means you can, in all the ways you can, at all the times you can, to all the people you can, as long as ever you can." - John Wesley |
|
|
|
Carefree
Advanced Member
Philippines
4217 Posts |
Posted - 01 June 2013 : 13:13:43
|
To remove the comma, delete these lines just after those:
To change the avatar size, modify the last line of code from my previous response as follows - then change the value in red until you get the size you want:
|
|
|
|
MaGraham
Senior Member
USA
1297 Posts |
Posted - 01 June 2013 : 14:05:02
|
Great!
I've got to go out for a while but will do this as soon as I return.
Since the members' bio, hobbies, etc. display on the right side of their profile, would it be much trouble to let their friends display on the left, Carefree?
Later. . .
|
"Do all the good you can, by all the means you can, in all the ways you can, at all the times you can, to all the people you can, as long as ever you can." - John Wesley |
|
|
|
Carefree
Advanced Member
Philippines
4217 Posts |
Posted - 01 June 2013 : 15:12:36
|
Not difficult. In "pop_profile.asp", look for this line (appx 487):
end if ' strRecentTopics
Move the entire section from the lines after 710 (between and including these lines) to just after line 487:
' ## User Space Below
' ## User Space Above
|
|
|
|
MaGraham
Senior Member
USA
1297 Posts |
Posted - 02 June 2013 : 00:50:48
|
Done. And, this looks so nice, Carefree! So much more professional, too!
Once again your work is Soo incredible and you are Sooo very much appreciated, Carefree!
|
"Do all the good you can, by all the means you can, in all the ways you can, at all the times you can, to all the people you can, as long as ever you can." - John Wesley |
|
|
|
MaGraham
Senior Member
USA
1297 Posts |
Posted - 14 October 2013 : 19:06:26
|
When members confirm a "Friend Request" their only option is to click on "Close Window" but that link doesn't work.
This is the link from the window where I just now accepted a "Friend Request." pop_user_space.asp?mode=friends&action=add&id=14 But I don't think the option to correct the link is there.
 |
"Do all the good you can, by all the means you can, in all the ways you can, at all the times you can, to all the people you can, as long as ever you can." - John Wesley |
|
|
|
Carefree
Advanced Member
Philippines
4217 Posts |
Posted - 14 October 2013 : 19:32:53
|
| The reason it doesn't work in Firefox (it may in Internet Explorer) is because Javascript isn't used to OPEN the window (it's opened from an EMail link), thus it cannot CLOSE the window. So the members can either click the X or hit Alt-F4 to close the window. |
Edited by - Carefree on 14 October 2013 19:33:51 |
|
|
|
MaGraham
Senior Member
USA
1297 Posts |
Posted - 14 October 2013 : 19:33:55
|
Here's my pop_user_space.asp.
<%
'#################################################################################
'##
'## USER SPACE MOD by cripto9t
'##
'## Version 1.1.02
'##
'## Date 02/14/08
'##
'## This file is not part of the Snitz Forum 2000 base code
'##
'## It is a file from the "User Space" modification for Snitz Forum 2000 version 3.4.06
'##
'#################################################################################
%>
<!--#INCLUDE FILE="config.asp"-->
<!--#INCLUDE FILE="inc_header_short.asp"-->
<!--#INCLUDE FILE="inc_sha256.asp"-->
<%
'Set values to suit your needs
'Values do not apply to mods and admins
Const blnLimit = true 'boolean holds member limits switch
Const intBookmarkMax = 100 'numeric holds max num of bookmarks a member can have
Const intFriendMax = 100 'numeric holds max num of friends a member can have
Dim blnDel
Dim memID
Dim strEncodedPassword
Dim Mode,intMode
Dim strAction
blnDel = false 'because you need proper credentials to delete
if mLev < 1 or MemberID < 1 then
getErrMsg "You Must be logged in to view this page."
end if
strEncodedPassword = trim(Request.Cookies(strUniqueID & "User")("Pword"))
Mode = ChkString(trim(lcase(Request.QueryString("mode"))), "sqlstring")
'need to store member id in another variable if admin is on the prowl
if mLev = 4 and (trim(Request.Querystring("memid")) <> "" and isNumeric(Request.Querystring("memid"))) = true then
blnDel = true
memID = cLng(Request.Querystring("memid"))
else
memID = MemberID
end if
'## Stop page right here if feature variable is "off" or nonexeistent.
'## or assign some values
Select case Mode
case "draft"
call chkVariable (strUSDraftSwitch,"Drafts")
intMode = 2
case "bookmark"
call chkVariable (strUSBookmarkSwitch,"Bookmarks")
intMode = 3
intMax = intBookmarkMax
case "friends"
call chkVariable(strUSFriendSwitch,"Friends")
intMode = 4
intMax = intFriendMax
'case "enemy"
' call chkVariable(strUSEnemySwitch,"Enemies")
case else
Response.Redirect "default.asp"
end select
Select case intMode
'## Start draft section
case 2
if trim(Request.QueryString("draft_id")) <> "" and isNumeric(Request.QueryString("draft_id")) = true then
DraftID = cLng(Request.QueryString("draft_id"))
else
DraftID = ""
end if
if DraftID <> "" then
Response.Write "<form action=""pop_user_space.asp?mode=" & Mode & """ name=""draft"" id=""draft"" method=""post"">" &vbNewLine & _
" <input type=""hidden"" name=""action"" value=""delete"">" & vbNewLine & _
" <input type=""hidden"" name=""draftid"" value=""" & DraftID & """>" & vbNewLine
if blnDel then
Response.Write "<input type=""hidden"" name=""memid"" value=""" & memID & """>" & vbnewLine
end if
Response.Write " <p align=""center""><font color=""" & strDefaultFontColor & """ size=""" & strDefaultFontSize & """ face=""" & strDefaultFontFace & """><b>Are you sure you want to delete this draft?</b></font></p>" & vbNewLine & _
" <br /><input type=""submit"" value=""Yes"" name=""draft"" id=""draft"">" & vbNewLine & _
"</form>" & vbNewLine
else
if trim(Request.Form("draftid")) <> "" then
if isNumeric(Request.Form("draftid")) = true then
DraftID = cLng(Request.Form("draftid"))
else
getErrMsg "Do Not Edit URL to Access this Page! 1"
end if
else
getErrMsg "Do Not Edit URL to Access this Page! 2"
end if
if mLev = 4 then
if trim(Request.Form("memid")) <> "" and isNumeric(Request.Form("memid")) then
blnDel = true
memID = cLng(Request.Form("memid"))
else
blnDel = chkCanEdit(strDBNTUserName,strEncodedPassword,2,DraftID)
memID = MemberID
end if
else
blnDel = chkCanEdit(strDBNTUserName,strEncodedPassword,2,DraftID)
end if
if blnDel = true then
strSql = "DELETE FROM " & strTablePrefix & "DRAFTS WHERE D_AUTHOR = " & memID & " AND DRAFT_ID = " & DraftID
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
if Err.description <> "" then
getErrMsg "There was an error = " & Err.description
else
Response.Write " <p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """><b>Draft Deleted!</b></font></p>" & vbNewLine & _
" <script language=""javascript1.2"">self.opener.location.reload();</script>" & vbNewLine
end if
else
getErrMsg "You Have No Permissions to Delete this Draft!!"
end if
end if
'## Bookmarks section
case 3
Dim strType
if trim(Request.Querystring("action")) <> "" then
strAction = trim(lcase(Request.Querystring("action")))
if strAction = "add" then
if chkFolderCnt(MemberID,intMax,intMode) then
getErrMsg "Your Bookmark Folder is Currently Full.<br />Forum limits are " & intMax & " bookmarks."
end if
strType = trim(lcase(Request.Querystring("type")))
if strType = "post" then
if trim(Request.QueryString("topic_id")) <> "" then
if isNumeric(Request.QueryString("topic_id")) = true then
Topic_ID = cLng(Request.QueryString("topic_id"))
else
getErrMsg "Problem - not getting a numeric topic id"
end if
else
getErrMsg "Problem - Not getting a topic id"
end if
if trim(Request.QueryString("reply_id")) <> "" then
if isNumeric(Request.QueryString("reply_id")) = true then
Reply_ID = cLng(Request.QueryString("reply_id"))
else
getErrMsg "Problem - not getting a numeric reply id"
end if
else
Reply_ID = ""
end if
if trim(Request.QueryString("archive")) = "true" then
strActivePrefix = strTablePrefix & "A_"
ArchiveView = "true"
ArchiveLink = "ARCHIVE=true&"
else
strActivePrefix = strTablePrefix
ArchiveView = ""
ArchiveLink = ""
end if
'# build url
if inStr(strForumUrl,"default.asp/") then
ForumLink = replace(strForumUrl,"default.asp/", "topic.asp")
else
ForumLink = strForumUrl & "topic.asp"
end if
ArchiveLink = ""
PageLink = ""
AnchorLink = ""
if ArchiveView = "true" then
ArchiveLink = "ARCHIVE=true&"
end if
if Reply_ID <> "" then
PageLink = "whichpage=-1&"
TopicLink = "TOPIC_ID=" & Topic_ID & "&"
AnchorLink = "Reply_ID=" & Reply_ID
else
TopicLink = "TOPIC_ID=" & Topic_ID
end if
QueryLink = "?" & ArchiveLink & PageLink & TopicLink & AnchorLink
strUrl = ForumLink & QueryLink
'# Get topic subject
strSql = "SELECT T_SUBJECT, F_SUBJECT " & _
" FROM " & strActivePrefix & "TOPICS T, " & strTablePrefix & "FORUM F " & _
" WHERE TOPIC_ID = " & Topic_ID & " AND T.FORUM_ID = F.FORUM_ID"
set rs = Server.CreateObject("ADODB.Recordset")
rs.open strSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
if rs.EOF then
getErrMsg "Do Not Edit the URL to gain access to this page!<br />Topic does not exist!"
else
if Reply_ID <> "" then
strTitle = chkString("Re-" & rs("T_SUBJECT"),"display")
else
strTitle = chkString(rs("T_SUBJECT"),"display")
end if
ForumSubject = chkString(rs("F_SUBJECT"),"display")
end if
rs.close
set rs = nothing
else
if strType = "url" then
'## nonforum link
strUrl = ""
strTitle = ""
else
getErrMsg "Do Not Edit URL to access this page.<br />Type Missing."
end if
end if
'## get existing bookmark categories
strSql = "SELECT DISTINCT B_CAT FROM " & strTablePrefix & "BOOKMARKS WHERE B_MEMBER = " & MemberID & " ORDER BY B_CAT ASC;"
set rs = Server.CreateObject("ADODB.Recordset")
rs.open strSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
if rs.EOF then
CatCnt = ""
else
allCatData = rs.GetRows(adGetRowsRest)
CatCnt = UBound(allCatData,2)
end if
rs.close
set rs = nothing
'## Build form
Response.Write "<form action=""pop_user_space.asp?mode=" & Mode & """ method=""post"" name=""bookmarks"" id=""bookmarks"">" & vbNewLine & _
"<input type=""hidden"" name=""action"" value=""add"">" & vbNewLine & _
" <table border=""0px"" width=""95%"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center"" colspan=""2""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """ color=""" & strDefaultFontColor & """><b>Bookmark</b></font></td>" & vbNewLine & _
" </tr>" & vbNewLine
if strtype = "post" then
Response.Write " <tr>" & vbNewLine & _
" <td align=""right""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>Default Category: </b></font></td>" & vbNewLine & _
" <td align=""left""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """> <input type=""text"" size=""40"" name=""defaultcategory"" value=""" & ForumSubject & """ readonly /></font></td>" & vbNewLine & _
" </tr>" & vbNewLine
end if
'## list Categories
if CatCnt <> "" then
Response.Write " <tr>" & vbNewLine & _
" <td align=""right""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>Your Categorys: </b></font></td>" & vbNewLine & _
" <td align=""left""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>" & vbNewLine & _
" <select size=""1"" name=""oldcategory"">" & vbNewLine & _
" <option value=""""></option>" & vbNewLine
NewCat = 1
for iCat = 0 to CatCnt
CatSubject = allCatData(0,iCat)
Response.Write " <option value=""" & chkString(CatSubject,"display") & """ "
if trim(CatSubject) = trim(ForumSubject) then
Response.Write "selected"
NewCat = 0
end if
Response.Write ">" & chkString(CatSubject,"display") & "</option>" & vbNewLine
next
Response.Write " </select></font></td>" & vbNewLine & _
" </tr>" & vbNewLine
end if
Response.Write " <tr>" & vbNewLine & _
" <td align=""right""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>New Category: </b></font></td>" & vbNewLine & _
" <td align=""left""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """> <input type=""text"" size=""40"" name=""newcategory"" /></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""right""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>Title: </b></font></td>" & vbNewLine & _
" <td align=""left""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """> <input type=""text"" size=""40"" name=""title"" value=""" & strTitle & """ /></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""right""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>Url: </b></font></td>" & vbNewLine & _
" <td align=""left""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """> <input type=""text"" size=""40"" name=""url"" value=""" & strUrl & """"
if strType = "post" then Response.Write "readonly"
Response.Write " /></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td colspan=""2"" align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """> <input type=""submit"" name=""bookmarks"" id=""bookmarks"" value="" OK "" /> <input type=""reset"" value=""Reset"" id=""reset1"" name=""reset1""></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine & _
"</form>" & vbNewLine
else
if strAction = "delete" then
if trim(Request.QueryString("id")) <> "" then
if isNumeric(Request.QueryString("id")) = true then
BookMark_ID = cLng(Request.QueryString("id"))
else
getErrMsg "Do Not Edit URL to access this page.<br />BookmarkID is not numeric."
end if
else
getErrMsg "Do Not Edit URL to access this page.<br />BookmarkID is missing."
end if
else
getErrMsg "Do Not Edit URL to access this page.<br />Action is missing."
end if
Response.Write "<form action=""pop_user_space.asp?mode=" & Mode & """ name=""bookmark"" id=""bookmark"" method=""post"">" &vbNewLine & _
" <input type=""hidden"" name=""action"" value=""delete"">" & vbNewLine & _
" <input type=""hidden"" name=""id"" value=""" & Bookmark_ID & """>" & vbNewLine
if blnDel then
Response.Write " <input type=""hidden"" name=""memid"" value=""" & memID & """>" & vbNewLine
end if
Response.Write " <p align=""center""><font color=""" & strDefaultFontColor & """ size=""" & strDefaultFontSize & """ face=""" & strDefaultFontFace & """><b>Are you sure you want to delete this bookmark?</b></font></p>" & vbNewLine & _
" <br /><input type=""submit"" value=""Yes"" name=""bookmark"" id=""bookmark"">" & vbNewLine & _
"</form>" & vbNewLine
end if
else
if trim(Request.Form("action")) <> "" then
strAction = trim(lcase(Request.Form("action")))
if strAction = "add" then
if trim(Request.Form("url")) <> "" then
if IsValidURL(trim(Request.Form("url"))) then
strUrl = trim(Request.form("url"))
else
errMsg = "Invalid URL - " & strURLError
end if
else
getErrMsg "You must enter a url."
end if
if trim(Request.Form("title")) <> "" then
strTitle = trim(Request.Form("title"))
else
getErrMsg "You must enter a title."
end if
if trim(Request.Form("defaultcategory")) <> "" then
strDefCat = trim(Request.Form("defaultcategory"))
else
strDefCat = ""
end if
if trim(Request.Form("oldcategory")) <> "" then
strOldCat = trim(Request.Form("oldcategory"))
else
strOldCat = ""
end if
if trim(Request.Form("newcategory")) <> "" then
strNewCat = trim(Request.Form("newcategory"))
else
strNewCat = ""
end if
if strNewCat <> "" then
strCat = strNewCat
elseif strOldCat <> "" then
strCat = strOldCat
else
strCat = strDefCat
end if
if strCat = "" then getErrMsg "You must enter a category."
if errMsg <> "" then getErrMsg "" & errMsg & ""
if addBookmark(MemberID,strUrl,strTitle,strCat) then
Response.Write " <p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """><b>Url was added to your bookmarks</b></font></p>" & vbNewLine & _
" <script language=""javascript1.2"">self.opener.location.reload();</script>" & vbNewLine
end if
else
if strAction = "delete" then
if trim(Request.Form("id")) <> "" then
if isNumeric(Request.Form("id")) = true then
BookmarkID = cLng(Request.Form("id"))
else
getErrMsg "Problem - Not getting a numeric bookmark id"
end if
else
getErrMsg "Problem - Not getting a bookmark id."
end if
if mLev = 4 then
if trim(Request.Form("memid")) <> "" and isNumeric(Request.Form("memid")) then
blnDel = true
memID = cLng(Request.Form("memid"))
else
blnDel = chkCanEdit(strDBNTUserName,strEncodedPassword,3,BookmarkID)
memID = MemberID
end if
else
blnDel = chkCanEdit(strDBNTUserName,strEncodedPassword,3,BookmarkID)
memID = MemberID
end if
if blnDel = true then
if delBookmark(memID,BookmarkID) then
Response.Write " <p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """><b>Bookmark Deleted!</b></font></p>" & vbNewLine & _
" <script language=""javascript1.2"">self.opener.location.reload();</script>" & vbNewLine
end if
else
getErrMsg "You Have No Permissions to Delete this Bookmark!!"
end if
else
getErrMsg "Do Not Edit URL to access this page.<br />Form action is not right."
end if
end if
else
getErrMsg "Do Not Edit URL to access this page.<br />Form action is not right."
end if
end if
'## Start Friends Section
case 4
if trim(Request.Querystring("action")) <> "" then
strAction = trim(lcase(Request.Querystring("action")))
if trim(Request.Querystring("id")) <> "" then
if isNumeric(Request.Querystring("id")) = true then
FriendID = cLng(Request.Querystring("id"))
else
getErrMsg "Do not edit the URL to access this page"
end if
else
getErrMsg "Do not edit the URL to access this page."
end if
' Part of ignore mod - coming soon
'if trim(Request.Querystring("type")) <> "" then
' if isNumeric(Request.Querystring("type")) = true then
' FriendType = cLng(Request.Querystring("type"))
' else
' getErrMsg "Do not edit the URL to access this page"
' end if
'else
' getErrMsg "Do not edit the URL to access this page."
'end if
select case strAction
case "add"
if chkFolderCnt(MemberID,intFriendMax,intMode) then
getErrMsg "Your Friends folder is Currently Full.<br />Forum limits are " & intMax & " friends."
end if
strInputAction = "add"
case "delete"
strInputAction = "delete"
end select
if strInputAction = "add" or strInputAction = "delete" then
Response.Write "<form action=""pop_user_space.asp?mode=" & Mode & """ method=""post"" name=""friends"" id=""friends"">" & vbNewLine & _
"<input type=""hidden"" name=""id"" value=""" & FriendID & """ />" & vbNewLine & _
"<input type=""hidden"" name=""action"" value=""" & strInputAction & """ />" & vbNewLine
if blnDel then
Response.Write "<input type=""hidden"" name=""memid"" value=""" & memID & """>" & vbNewLine
end if
Response.Write " <table border=""0px"" width=""95%"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """ color=""" & strDefaultFontColor & """><b>Friends</b></font></td>" & vbNewLine & _
" </tr>" & vbNewLine
if strInputAction = "add" then
Response.Write " <tr>" & vbNewLine & _
" <td align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>"
'if FriendType = 0 then IGNORE MOD
Response.Write "<b>Level:</b> A. <input type=""radio"" name=""level"" value=""0"" checked /> B. <input type=""radio"" name=""level"" value=""1"" /> C. <input type=""radio"" name=""level"" value=""2"" /><br />"
'else
' Response.Write " Ignore Member <input type=""radio"" name=""level"" value=""3"" checked /> Disallow Member <input type=""radio"" name=""level"" value=""4"" /><br />"
'end if
Response.Write " </td>" & vbNewLine & _
" </tr>" & vbNewLine
end if
Response.Write " <tr>" & vbNewLine & _
" <td align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>" & uCase(strInputAction)
if strInputAction = "add" then
Response.Write " to your friends list?"
else
Response.Write " from your friends list?"
end if
Response.Write "</b></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """> <input type=""submit"" name=""friends"" id=""friends"" value="" Confirm "" /></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine & _
"</form>" & vbNewLine
else
getErrMsg "Do not edit the URL to access this page."
end if
else
if trim(Request.Form("action")) <> "" then
strAction = trim(lcase(Request.Form("action")))
if trim(Request.Form("id")) <> "" and isNumeric(Request.Form("id")) = true then
FriendID = cLng(Request.form("id"))
elseif trim(Request.Querystring("id")) <> "" and isNumeric(Request.Querystring("id")) = true then
FriendID = cLng(Request.Querystring("id"))
else
getErrMsg "Problem - Not getting needed form input - id."
end if
select case strAction
case "add"
'## check for self addition
if MemberID = FriendID then getErrMsg "Adding yourself to your friends list is not allowed.<br />Do not edit URL to access this page"
if trim(Request.Form("level")) <> "" and isNumeric(Request.Form("level")) = true then
FriendLevel = cLng(Request.form("level"))
else
getErrMsg "Problem - Not getting needed form input - level."
end if
'## Check exists
strSql = "SELECT M_NAME, M_EMAIL FROM " & strMemberTablePrefix & "MEMBERS " & _
"WHERE MEMBER_ID = " & FriendID
set rs = Server.CreateObject("ADODB.Recordset")
rs.open strSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
if rs.EOF or rs.BOF then
rs.close
set rs=nothing
getErrMsg "Member does not exist!"
else
FriendName = rs("M_NAME")
FriendMail = rs("M_EMAIL")
rs.close
set rs=nothing
'## check for duplicate
if chkFriend(MemberID,FriendID) = true then
'## Add friend
if addFriend(MemberID,FriendID,FriendLevel) = true then
getMsg FriendName & " has been added to you forum friends folder."
else
getErrMsg "Friends Problem - Should not be able to get this far."
end if
else
'## Error Msg
end if
end if
case "delete"
if mLev = 4 then
if trim(Request.Form("memid")) <> "" and isNumeric(Request.Form("memid")) then
blnDel = true
memID = cLng(Request.Form("memid"))
else
blnDel = chkCanEdit(strDBNTUserName,strEncodedPassword,4,FriendID)
memID = MemberID
end if
else
blnDel = chkCanEdit(strDBNTUserName,strEncodedPassword,4,FriendID)
memID = MemberID
end if
strSql = "SELECT FRIEND_ID, M_NAME " & _
"FROM " & strTablePrefix & "FRIENDS, " & strMemberTablePrefix & "MEMBERS " & _
"WHERE F_MEMBER = " & memID & " AND FRIEND_ID = " & FriendID & " AND MEMBER_ID = F_FRIEND"
set rs = Server.CreateObject("ADODB.Recordset")
rs.open strSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
if rs.EOF or rs.BOF then
rs.close
set rs=nothing
getErrMsg "Either Member is not in your friends folder or Member does not exist!<br />Do Not Edit URL to access this page!"
else
fFriendID = rs("FRIEND_ID")
FriendName = rs("M_NAME")
rs.close
set rs=nothing
if blnDel = true then
if delFriend(memID,FriendID) = true then
Response.Write " <p align=""center""><font size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """ face=""" & strDefaultFontFace & """><b>" & FriendName & " has been deleted from your forum friends folder.</b></font></p>" & vbNewLine & _
" <script language=""javascript1.2"">self.opener.location.reload();</script>" & vbNewLine
else
getErrMsg "Friends Problem - Should not be able to get this far."
end if
end if
end if
end select
else
getErrMsg "Do Not edit the URL to access this page.?"
end if
end if
case else
getErrMsg "Please do not edit the url to gain access to this page!!!!"
end select
WriteFooterShort
Response.End
sub getMsg(msg)
Response.Write "<p align=""center""><font color=""" & strDefaultFontColor & """ size=""" & strDefaultFontSize & """ face=""" & strDefaultFontFace & """><b>" & msg & "</b></font></p>" & vbNewline
WriteFooterShort
Response.End
end sub
sub getErrMsg(msg)
Response.Write "<p align=""center""><font color=""" & strHiLiteFontColor & """ size=""" & strDefaultFontSize & """ face=""" & strDefaultFontFace & """><b>" & msg & "</b></font></p>" & vbNewline
WriteFooterShort
Response.End
end sub
function chkFolderCnt(mMemID,fMax,fType)
dim bTmp
bTmp = false
if mLev < 3 or blnLimit = true then
dim strSql,rsChk
dim strTable,strIDCol,strCol
dim TotalFiles
select case cLng(fType)
case 3
strTable = "BOOKMARKS"
strIDCol = "BOOKMARK_ID"
strCol = "B_MEMBER"
case 4
strTable = "FRIENDS"
strIDCol = "FRIEND_ID"
strCol = "F_MEMBER"
end select
strSql = "SELECT COUNT(" & strIDCol & ") AS TOTAL_FILES " & _
"FROM " & strTablePrefix & strTable & " " & _
"WHERE " & strCol & " = " & mMemID
set rsChk = my_Conn.Execute (strSql)
TotalFiles = rsChk(0).value
rsChk.close
set rsChk = nothing
if TotalFiles < fMax then
'do nothing - # entries less than max
else
bTmp = true
end if
end if
chkFolderCnt = bTmp
end function
function chkCanEdit(mName,mPassword,fType,fID)
dim bTmp,strSql,rsChk
dim strTable,strIDCol,strCol,strMsg
bTmp = false
select case cLng(fType)
case 2
strTable = "DRAFTS"
strIDCol = "DRAFT_ID"
strCol = "D_AUTHOR"
case 3
strTable = "BOOKMARKS"
strIDCol = "BOOKMARK_ID"
strCol = "B_MEMBER"
case 4
strTable = "FRIENDS"
strIDCol = "FRIEND_ID"
strCol = "F_MEMBER"
case else
strMsg = "There has been an error.<br />"
if mLev = 4 then
strMsg = strMsg & "Feature is out of range - function chkCanEdit."
else
strMsg = strMsg & "Please inform Amin."
end if
getErrMsg strMsg
end select
strSql = "SELECT " & strCol & ", M.MEMBER_ID, M.M_LEVEL, M.M_NAME " & _
"FROM " & strMemberTablePrefix & "MEMBERS M, " & strTablePrefix & strTable & " " & _
"WHERE M." & strDBNTSQLName & " = '" & mName & "' "
if strAuthType="db" then
strSql = strSql & " AND M.M_PASSWORD = '" & mPassword &"' "
end If
strSql = strSql & " AND " & strIDCol & " = " & fID & " "
strSql = strSql & " AND M.M_STATUS = " & 1
set rsChk = my_Conn.Execute (strSql)
if rsChk.BOF or rsChk.EOF then
'Do nothing
else
if cLng(rsChk("MEMBER_ID")) = cLng(rsChk(strCol)) then
bTmp = true 'author
end if
end if
rsChk.close
set rsChk = nothing
chkCanEdit = bTmp
end function
Function IsValidURL(sValidate)
Dim sInvalidChars
Dim bTemp
Dim i
if trim(sValidate) = "" then IsValidURL = true : exit function
sInvalidChars = """;+()*'<>"
for i = 1 To Len(sInvalidChars)
if InStr(sValidate, Mid(sInvalidChars, i, 1)) > 0 then bTemp = True
if bTemp then strURLError = "<br />• cannot contain any of the following characters: "" ; + ( ) * ' < > "
if bTemp then Exit For
next
if not bTemp then
for i = 1 to Len(sValidate)
if Asc(Mid(sValidate, i, 1)) = 160 then bTemp = True
if bTemp then strURLError = "<br />• cannot contain any spaces "
if bTemp then Exit For
next
end if
' extra checks
' check to make sure URL begins with http:// or https://
if not bTemp then
bTemp = (lcase(left(sValidate, 7)) <> "http://") and (lcase(left(sValidate, 8)) <> "https://")
if bTemp then strURLError = "<br />• must begin with either http:// or https:// "
end if
' check to make sure URL is 255 characters or less
if not bTemp then
bTemp = len(sValidate) > 255
if bTemp then strURLError = "<br />• cannot be more than 255 characters "
end if
' no two consecutive dots
if not bTemp then
bTemp = InStr(sValidate, "..") > 0
if bTemp then strURLError = "<br />• cannot contain consecutive periods "
end if
'no spaces
if not bTemp then
bTemp = InStr(sValidate, " ") > 0
if bTemp then strURLError = "<br />• cannot contain any spaces "
end if
if not bTemp then
bTemp = (len(sValidate) <> len(Trim(sValidate)))
if bTemp then strURLError = "<br />• cannot contain any spaces "
end if 'Addition for leading and trailing spaces
' if any of the above are true, invalid string
IsValidURL = Not bTemp
End Function
function chkUrl(fStr)
fStr = Replace(fStr,"#","&#")
fStr = ChkString(fStr, "SQLString")
chkUrl = fStr
end function
Sub chkVariable(strVar,strDesc)
if trim(strVar) <> "" then
if cLng(strVar) < 1 then
if mLev > 2 then
getErrMsg "Admin has " & strDesc & " turned off."
else
Response.Redirect "default.asp"
end if
end if
else
if mLev = 4 then
getErrMsg strDesc & " could not be found in Database."
else
Response.Redirect "default.asp"
end if
end if
end Sub
function addBookmark(iMemId,sUrl,sTitle,sCat)
dim bTmp,strSql
bTmp = false
strSql = "INSERT INTO " & strTablePrefix & "BOOKMARKS(B_URL, B_MEMBER, B_TITLE, B_CAT, B_DATE" & _
") VALUES (" & _
"'" & chkUrl(sUrl) & "', " & iMemID & ", '" & chkString(sTitle,"SQLString") & "', '" & chkString(sCat,"SQLString") & "', '" & DateToStr(strForumTimeAdjust) & "')"
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
if Err.description <> "" then
getErrMsg "There was an error = " & Err.description
else
bTmp = true
end if
addBookmark = bTmp
end function
function delBookmark(iMemID,iBookmarkID)
dim bTmp,strSql
bTmp = false
strSql = "DELETE FROM " & strTablePrefix & "BOOKMARKS " & _
"WHERE B_MEMBER = " & iMemID & " AND BOOKMARK_ID = " & iBookmarkID
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
if Err.description <> "" then
getErrMsg "There was an error = " & Err.description
else
bTmp = true
end if
delBookmark = bTmp
end function
'## Friends Specific Functions ####################
function chkFriend(iMemID,iFriendID)
dim bTemp,strSql,rsChk
bTemp = false
strSql = "SELECT F_FRIEND FROM " & strTablePrefix & "FRIENDS " & _
"WHERE F_MEMBER = " & iMemID & " AND F_FRIEND = " & iFriendID
set rsChk = my_Conn.Execute (strSql)
if rsChk.EOF or rsChk.BOF then
bTemp = true
rsChk.close
set rsChk = nothing
else
rsChk.close
set rsChk = nothing
getErrMsg "Member already exists in your friends folder."
exit function
end if
chkFriend = bTemp
end function
function addFriend(iMemID,iFriendID,iLev)
dim bTmp, strSql
bTmp = false
strSql = "INSERT INTO " & strTablePrefix & "FRIENDS " & _
"(F_MEMBER, F_FRIEND, F_LEVEL, F_DATE) VALUES " & _
"(" & iMemID & ", " & iFriendID & ", " & iLev & ", '" & DateToStr(strForumTimeAdjust) & "')"
'Response.Write strSql
'Response.End
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
if err.description <> "" then
getErrMsg err.description, 0
else
bTmp = true
end if
addFriend = bTmp
if strEmail = "1" then
strRecipientsName = FriendName
strRecipients = FriendMail
strFrom = strSender
strFromName = strForumTitle
strsubject = strForumTitle & " Friends' List "
strMessage = "Hello " & FriendName & vbNewline & vbNewline
strMessage = strMessage & "You received this message from " & strForumTitle & " because " & strDBNTUserName & " wishes to befriend you on the forums at " & strForumURL & vbNewline & vbNewline
strMessage = strMessage & "To ignore " & strDBNTUserName & "'s request, simply do nothing." & vbNewline & vbNewline
strMessage = strMessage & "To befriend " & strDBNTUserName & ", click here: " & strForumURL & "pop_user_space.asp?mode=friends&action=add&id=" & MemberID & vbNewline & vbNewline
strMessage = strMessage & "or, if you have already added " & strDBNTUserName & " as a friend, you can remove " & strDBNTUserName & " from your friends' list here: " & strForumURL & "pop_user_space.asp?mode=friends&action=delete&id=" & MemberID & vbNewline & vbNewline
%>
<!--#INCLUDE FILE="inc_mail.asp" -->
<%
end if
end function
function delFriend(iMemID,iFriendID)
dim bTmp, strSql
bTmp = false
strSql = "DELETE FROM " & strTablePrefix & "FRIENDS " & _
"WHERE F_MEMBER = " & iMemID & " AND FRIEND_ID = " & iFriendID
my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords
if err.description <> "" then
getErrMsg err.description, 0
else
bTmp = true
end if
delFriend = bTmp
end function
'## End Friends specifics
%>
|
"Do all the good you can, by all the means you can, in all the ways you can, at all the times you can, to all the people you can, as long as ever you can." - John Wesley |
|
|
|
MaGraham
Senior Member
USA
1297 Posts |
Posted - 14 October 2013 : 19:35:48
|
OOPS! I think we posted about the same time, Carefree.
Thank you!
|
"Do all the good you can, by all the means you can, in all the ways you can, at all the times you can, to all the people you can, as long as ever you can." - John Wesley |
|
|
|
MaGraham
Senior Member
USA
1297 Posts |
Posted - 14 October 2013 : 19:37:20
|
Oh, could the link be changed to default.asp? If so, how/where would I do that?
|
"Do all the good you can, by all the means you can, in all the ways you can, at all the times you can, to all the people you can, as long as ever you can." - John Wesley |
|
|
|
Carefree
Advanced Member
Philippines
4217 Posts |
Posted - 15 October 2013 : 03:09:57
|
Change line 596 to say this (I think you call your forum "community"):
Response.Write " <p><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><a href=""default.asp"">Community</a></font></p>" & vbNewLine & _
" </font>" & vbNewLine & _
" </div>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
"</table>" & vbNewLine & _
"</body>" & vbNewLine & _
"</html>" & vbNewLine
my_Conn.Close
set my_Conn = nothing
|
|
|
|
MaGraham
Senior Member
USA
1297 Posts |
Posted - 15 October 2013 : 15:25:14
|
quote:
Originally posted by Carefree
Change line 596 to say this (I think you call your forum "community"):
Response.Write " <p><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><a href=""default.asp"">Community</a></font></p>" & vbNewLine & _
" </font>" & vbNewLine & _
" </div>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
"</table>" & vbNewLine & _
"</body>" & vbNewLine & _
"</html>" & vbNewLine
my_Conn.Close
set my_Conn = nothing
Line 596 is this below.
WriteFooterShort
Replace that one line with all of the above, Carefree?
|
"Do all the good you can, by all the means you can, in all the ways you can, at all the times you can, to all the people you can, as long as ever you can." - John Wesley |
|
|
|
Carefree
Advanced Member
Philippines
4217 Posts |
Posted - 15 October 2013 : 15:37:05
|
| yes |
|
|
|
MaGraham
Senior Member
USA
1297 Posts |
Posted - 15 October 2013 : 16:12:07
|
That placed the link on the page where members click to confirm a friend request. Example: pop_user_space.asp?mode=friends&action=add&id=70
After confirming a friend, in the next window that opens. . .that's the window which only has the option to "Close Window" that doesn't work. Here's the link for this window: pop_user_space.asp?mode=friends
I like the option of having the link in the first window though, so I'll just leave it there.
|
"Do all the good you can, by all the means you can, in all the ways you can, at all the times you can, to all the people you can, as long as ever you can." - John Wesley |
|
|
|
Topic |
|
|
|
