%
Response.Redirect "http://www.orientbeachforum.com"
%>
All Forums
<%
on error resume next
public maxpages
'check to see if they are logged in I don't think this supports NT accounts
if strDBNTUserName <> "" then
strSql = "SELECT MEMBER_ID, M_LEVEL"
strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS "
strSql = strSql & " WHERE M_Name = '" &strDBNTUserName& "'"
M_ID = my_conn.execute(strSql)
sqldtl = M_ID("MEMBER_ID")
sqldtl = cint(trim(sqldtl))
mem_id = sqldtl
'response.write sqldtl
'response.write mem_id
mLev = cint(trim(M_ID("M_LEVEL")))
'verify their account against the photo album accounts
if sqldtl = 0 then
response.write "You do not have an album account.
"&vbNewLine
'no account no edit!
else
end if
end if
NavBar
SortBar
response.buffer = true
'on error resume next
set My_Conn = Server.CreateObject("ADODB.Connection")
My_Conn.Open strConnString
Set objFileSysObj = CreateObject("Scripting.FileSystemObject")
'#################################################################################
'# This is the part of the Photo Album that allows members to view the posted photos
'#################################################################################
sub RecentPhotos
response.buffer = true
'on error resume next
Response.Write " " & vbNewLine
'end javascript block
set My_Conn = Server.CreateObject("ADODB.Connection")
My_Conn.Open strConnString
Set objFileSysObj = CreateObject("Scripting.FileSystemObject")
if strDBNTUserName = "" then
response.redirect "default.asp"
end if
show_pop = 0
cname = request.QueryString("cname")
tMID = trim(cint(request.QueryString("mid")))
cid = trim(cint(request.QueryString("cid")))
strSql = "select * from "& strTablePrefix & "ALBUM_CONFIG"
strConf = My_Conn.execute(strSql)
file_size = trim(strConf("file_size"))
bdir = trim(strConf("base_dir"))
tb = strConf("thumbnails")
tb = cint(tb)
show_pop = cint(strConf("pop_win"))
width = cint(strConf("base_width"))
hight = cint(strConf("base_hight"))
loffset = cint(strConf("offset_left"))
toffset = cint(strConf("offset_top"))
single_album = cint(strConf("single_album"))
img_type = trim(strConf("img_type"))
gif = trim(left(img_type, 1))
jpg = trim(right(left(img_type, 3),1))
tif = trim(right(left(img_type, 5),1))
png = trim(right(left(img_type, 7),1))
bmp = trim(right(left(img_type, 9),1))
sort = request.querystring("sort")
direction = request.querystring("dir")
range = request.querystring("range")
criteria = request.querystring("si")
action = request.querystring("action")
select case sort
case "t"
strSqlSort = " order by " & strMemberTablePrefix & "album.photo_title "
sortOption = "Title"
case "f"
strSqlSort = " order by " & strMemberTablePrefix & "album.photo_name "
sortOption = "Name"
case "l"
strSqlSort = " order by " & strMemberTablePrefix & "album.photo_loc "
sortOption = "Location"
case "c"
strSqlSort = " order by " & strMemberTablePrefix & "album.ul_dttm "
sortOption = "Date"
case "d"
strSqlSort = " order by " & strMemberTablePrefix & "album.ul_dttm "
sortOption = "Posted Date"
case "v"
strSqlSort = " order by " & strMemberTablePrefix & "album.views "
sortOption = "Views"
case else
strSqlSort = " order by " & strMemberTablePrefix & "album.photo_id desc"
end select
strSqlSort = strSqlSort & direction
select case action
case "my"
sqldtl = "select " & strMemberTablePrefix & "album.*, " & strMemberTablePrefix & "album_users.m_name " & _
"from " & strMemberTablePrefix & "album INNER JOIN " & strMemberTablePrefix & "ALBUM_USERS ON " & strMemberTablePrefix & "ALBUM.Member_id = " & strMemberTablePrefix & "ALBUM_USERS.Member_id" & _
" where photo_status = 1 " & _
" and " & strMemberTablePrefix & "album.member_id = " & strMemberTablePrefix & "album_users.member_id " & _
" and " & strMemberTablePrefix & "album.member_id = " & mem_id
case "fav"
sqldtl = "SELECT " & strMemberTablePrefix & "ALBUM.*, " & strMemberTablePrefix & "ALBUM_USERS.M_NAME, " & strMemberTablePrefix & "ALBUM_FAVORITES.Member_id " & _
" FROM (" & strMemberTablePrefix & "ALBUM_FAVORITES INNER JOIN " & strMemberTablePrefix & "ALBUM ON " & strMemberTablePrefix & "ALBUM_FAVORITES.Photo_id = " & strMemberTablePrefix & "ALBUM.Photo_id) INNER JOIN " & strMemberTablePrefix & "ALBUM_USERS ON " & strMemberTablePrefix & "ALBUM.Member_id = " & strMemberTablePrefix & "ALBUM_USERS.Member_id " & _
" WHERE " & strMemberTablePrefix & "ALBUM_FAVORITES.Member_id= " & mem_id
case "search"
if range = "all" then
sqldtl = "select " & strMemberTablePrefix & "album.*, " & strMemberTablePrefix & "album_users.m_name " & _
"from " & strMemberTablePrefix & "album INNER JOIN " & strMemberTablePrefix & "ALBUM_USERS ON " & strMemberTablePrefix & "ALBUM.Member_id = " & strMemberTablePrefix & "ALBUM_USERS.Member_id" & _
" where photo_status = 1 " & _
" and " & strMemberTablePrefix & "album.member_id = " & strMemberTablePrefix & "album_users.member_id "
else
sqldtl = "select " & strMemberTablePrefix & "album.*, " & strMemberTablePrefix & "album_users.m_name " & _
"from " & strMemberTablePrefix & "album INNER JOIN " & strMemberTablePrefix & "ALBUM_USERS ON " & strMemberTablePrefix & "ALBUM.Member_id = " & strMemberTablePrefix & "ALBUM_USERS.Member_id" & _
" where photo_status = 1 " & _
" and " & strMemberTablePrefix & "album.member_id = " & strMemberTablePrefix & "album_users.member_id " & _
" and ul_dttm >= #" & now() - range & "#"
end if
if criteria <> "" then
criteria = "'%" & criteria & "%'"
sqldtl = sqldtl & " and (" & strMemberTablePrefix & "album.Photo_title like " & criteria & _
" or " & strMemberTablePrefix & "album.Photo_desc like " & criteria & _
" )"
end if
case else
sqldtl = "select top 12 " & strMemberTablePrefix & "album.*, " & strMemberTablePrefix & "album_users.m_name " & _
"from " & strMemberTablePrefix & "album INNER JOIN " & strMemberTablePrefix & "ALBUM_USERS ON " & strMemberTablePrefix & "ALBUM.Member_id = " & strMemberTablePrefix & "ALBUM_USERS.Member_id" & _
" where photo_status = 1 " & _
" and " & strMemberTablePrefix & "album.member_id = " & strMemberTablePrefix & "album_users.member_id "
end select
sqldtl = sqldtl & strSqlSort
'response.write sqldtl
set rs = Server.CreateObject("ADODB.Recordset")
rs.open sqldtl, my_Conn, adOpenStatic
itemsFound = rs.recordcount
if rs.EOF or rs.BOF then
Dim aData(0,0)
aData(0,0) = 0
else
aData = rs.GetRows
end if
rs.close: set rs=nothing
mypage = request("whichpage")
if ((Trim(mypage) = "") or (IsNumeric(mypage) = False)) then mypage = 1
mypage = cLng(mypage)
'set the mypage for the drop down
if Request.QueryString("whichpage") <> "" then
intPage = cint(Request.QueryString("whichpage"))
else
intPage = 1
end if
'check to see what page we are on if not set default it to the first page
intRecordsPerPage = 12 ' Records per page
if intFirstRecord + (intRecordsPerPage - 1) >= ubound(aData,2) then
else
if ((ubound(aData,2)+1) / intRecordsPerPage) > cint((ubound(aData,2)+1) / intRecordsPerPage) then
'check for any hangover records
maxpages = cint(((ubound(aData,2)+1) / intRecordsPerPage))
maxpages = maxpages + 1
'make sure we have enough pages to cover all the records
else
maxpages = cint(((ubound(aData,2)+1) / intRecordsPerPage))
end if
'needed for the dropdown navigation. Only likes Whole numbers no fractions!
end if
if aData(0,0) = 0 then
response.write "
| " 'Call DropDownPaging(1) response.write " | "&VbnewLine&_ ""&vbNewLine&_ ref & vbNewLine &_ " | "&VbnewLine&_ "
" & vbNewLine & _
"
" & b_ref&VbnewLine&_
" | "&VbnewLine&_
" ||||||||||||||||||
| Photo Details | " response.write "|||||||||||||||||||||||
| Poster: " & profileLink(ChkString(strMemberName,"display"),M_ID) & " "
response.write " (see this users gallery) " response.write " " response.write " " & rs("photo_desc") & " "
response.write " | "
response.write " |||||||||||||||||||||||
| · Date: " & rs("ul_dttm") & " · Views: "&rs("views")&" · | " response.write "|||||||||||||||||||||||
| Additional Info | " response.write " " response.write "|
| Location: "&rs("photo_loc")&" | " response.write "|
| Equipment Used: "&rs("photo_equip")&" | " response.write "|
| Exposure: "&rs("photo_exp")&" | " response.write "|
| Film & Developer: "&rs("photo_film")&" | " response.write "|
| Paper & Developer: "&rs("photo_paper")&" | " response.write "|
| " response.write " Add to Favorites · ·" response.write " Print View" if (mLev>=3) or (mem_id = M_ID) then Response.Write " · Delete Photo" & vbNewLine end if response.write " | |
" response.write " |
Viewing of this Topic is not permitted until it has been moderated.
Please try again later
| " if mypage > 1 then Response.Write(""&getCurrentIcon(strIconGoLeft,"","align=absmiddle")&"Previous") if mypage > 1 and mypage < maxpages then Response.Write(" | ") if mypage < maxpages then Response.Write(""&getCurrentIcon(strIconGoRight,"","align=absmiddle")&"Next") Response.Write " | " & vbNewLine & _ "
" & vbNewLine & _
"
| " & vbNewLine & _
" |||||||||||||||||||||||
| " if mypage > 1 then Response.Write(""&getCurrentIcon(strIconGoLeft,"","align=absmiddle")&"Previous") if mypage > 1 and mypage < maxpages then Response.Write(" | ") if mypage < maxpages then Response.Write(""&getCurrentIcon(strIconGoRight,"","align=absmiddle")&"Next") Response.Write " | " & vbNewLine & _ "
" & vbNewLine & _
"
" & vbNewLine end if end if end sub sub PostingOptions() Response.Write " " & vbNewLine if (mlev = 4 or mlev = 3 or mlev = 2 or mlev = 1) or (lcase(strNoCookies) = "1") or (strDBNTUserName = "") then if lcase(strEmail) = "1" and Topic_Status < 2 then if ((mlev <> 0) or (mlev = 0 and strLogonForMail <> "1")) and lcase(strShowSendToFriend) = "1" then Response.Write " " & getCurrentIcon(strIconSendTopic,,"align=absmiddle") & " Send Topic to a Friend" & vbNewLine end if end if if lcase(strShowPrinterFriendly) = "1" and Topic_Status < 2 then Response.Write " " & getCurrentIcon(strIconPrint,,"align=absmiddle") & " Printer Friendly" & vbNewLine end if end if Response.Write " " end sub sub AdminOptions(PHOTO_ID, loc) Response.Write " " & vbNewLine if (mLev >= 3) then Response.Write " " & getCurrentIcon(strIconDeleteReply,"Delete Gallery Entry","align=absmiddle hspace=6") & "" & vbNewLine end if Response.Write " " end sub function SearchHiLite(fStrMessage) 'function derived from HiLiTeR by 2eNetWorX fArr = split(replace(Request.QueryString("SearchTerms"),";",""), ",") strBuffer = "" for iPos = 1 to len(fStrMessage) bChange = False 'Looks for html tags if mid(fStrMessage, iPos, 1) = "<" then bInHTML = True end if 'Looks for End of html tags if bInHTML = True then if mid(fStrMessage, iPos, 1) = ">" then bInHTML = False end if end if if bInHTML <> True then for i = 0 to UBound(fArr) if fArr(i) <> "" then if lcase(mid(fStrMessage, iPos, len(fArr(i)))) = lcase(fArr(i)) then bChange = True strBuffer = strBuffer & "" & _ mid(fStrMessage, iPos, len(fArr(i))) & "" iPos = iPos + len(fArr(i)) - 1 end if end if next end if if Not bChange then strBuffer = strBuffer & mid(fStrMessage, iPos, 1) end if next SearchHiLite = strBuffer end function Function IgnoreMemberList() strSql = "SELECT I.I_IGNOREID FROM " & _ strTablePrefix & "IGNORE_MEMBER I WHERE I.I_MEMBERID = " & MemberID set rsIgnore = my_Conn.Execute(strSql) if rsIgnore.BOF or rsIgnore.EOF then rsIgnore.close set rsIgnore = nothing exit function else IgnoreMemberList = rsIgnore.GetRows() rsIgnore.close set rsIgnore = nothing end if End Function Function ChkIgnoreList(IgnoredMembers, CurrentMember) if IsArray(IgnoredMembers) = False then ChkIgnoreList = False exit function end if For iRow = 0 to UBound(IgnoredMembers, 2) if IgnoredMembers(0,iRow) = CurrentMember then ChkIgnoreList = True Exit Function end if Next ChkIgnoreList = False End Function Sub WriteIgnPostLinks(Photo_ID, ReplyID, IMemberID) if ReplyID > 0 then strReplyPart = "&REPLY_ID=" & ReplyID if mLev >= 3 then Response.Write "[View Post] " end if Response.Write "[Un-Ignore User]" End Sub sub NavBar response.write "
" & vbNewLine end sub sub DropDownPaging2(fnum) response.write "DropDownPaging1 " response.write maxpages if maxpages > 1 then if mypage = "" then pge = 1 else pge = mypage end if scriptname = request.servervariables("script_name") Response.Write(" " & vbNewLine) end if top = "0" end sub '############################################## '## New Function which is not a DropDown but '## we keep the functions name so that it works '## with Snitz '############################################### sub DropDownPaging(fnum) on error resume next photo_id = Request.QueryString("photo") loc = Request.QueryString("loc") mypage = Request.QueryString("whichpage") strQuery = request.queryString iPos = cint(instr(strQuery, "&whichpage")) - 1 if iPos > 0 then ref = mid(strQuery, 1, iPos) else ref = strQuery 'response.write " "&iPos 'response.write " "&strQuery 'response.write " "&ref if maxpages > 1 then if mypage = "" then pge = 1 else pge = mypage end if Response.Write " " & vbNewLine
Response.Write " (Page " & pge & " of " & maxpages &")  "
'We define the range to show
'we will currently only show 10 pages as the default
PagesToShow = 5
If cLng(pge) > 1 then
MinPageToShow = cLng(pge) - 1
Else
MinPageToShow = 1
End If
If cLng(pge) + PagesToShow > maxpages then
MaxPageToShow = maxpages
Else
MaxPageToShow = cLng(pge) + PagesToShow
End If
If MaxPageToShow < maxpages then
ShowMaxPage = True
Else
ShowMaxPage = False
End If
If MinPageToShow > 1 then
ShowMinPage = True
Else
ShowMinPage = False
End If
If ShowMinPage then
Response.Write " < "
End If
for counter = MinPageToShow to MaxPageToShow
if counter <> cLng(pge) then
'Response.Write "" & counter & " "
else
Response.Write "" & counter & " "
end if
Response.Write " "
next
If ShowMaxPage then
Response.Write "> "
End If
Response.Write " "
Response.Write(" | " & vbNewLine)
end if
end sub
Private Function getDir(strFilename)
Dim iPos
Dim x
On Error Resume Next
For x = 1 To Len(strFilename)
If Mid(strFilename, x, 1) = "/" Then
iPos = x
End If
Next
getDir = Left(strFilename, iPos)
End Function
Private Function getFileName(strFilename)
Dim iPos
On Error Resume Next
iLength = len(strFileName)
For x = 1 To Len(strFilename)
If Mid(strFilename, x, 1) = "/" Then
iPos = x
End If
Next
getFileName = right(strFilename, iLength - iPos)
End Function
%>
|