<%
'###############################################################################
'##
'##         Snitz Forums 2000 v3.4.07
'##
'###############################################################################
'##
'## Copyright © 2000-09 Michael Anderson, Pierre Gorissen,
'##         Huw Reddick and Richard Kinser
'##
'## This program is free. You can redistribute and/or modify it under the
'## terms of the GNU General Public License as published by the Free Software
'## Foundation; either version 2 or (at your option) any later version.
'##
'## All copyright notices regarding Snitz Forums 2000 must remain intact in
'## the scripts and in the HTML output.  The "powered by" text/logo with a
'## link back to http://forum.snitz.com in the footer of the pages MUST
'## remain visible when the pages are viewed on the internet or intranet.
'##
'## This program is distributed in the hope that it will be useful but
'## WITHOUT ANY WARRANTY; without even an implied warranty of MERCHANTABILITY
'## or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
'## for more details.
'##
'## You should have received a copy of the GNU General Public License along
'## with this program; if not, write to:
'##
'##         Free Software Foundation, Inc.
'##         59 Temple Place, Suite 330
'##         Boston, MA 02111-1307
'##
'## Support can be obtained from our support forums at:
'##
'##         http://forum.snitz.com
'##
'## Correspondence and marketing questions can be sent to:
'##
'##         manderson@snitz.com
'##
'###############################################################################
%>
<!--#INCLUDE FILE="config.asp"-->
<!--#INCLUDE FILE="inc_sha256.asp"-->
<!--#INCLUDE FILE="inc_header.asp" -->
<!--#INCLUDE FILE="inc_func_secure.asp" -->
<!--#INCLUDE FILE="inc_func_member.asp" -->
<!--#INCLUDE FILE="inc_func_posting.asp"-->
<%
if mLev<1 or (STRIMGINPOSTS<>"1" or STRIMAGEURL="") then
	Response.Redirect	"default.asp"
end if
Response.Write	"<table border=""0"" width=""100%"">" & vbNewLine & _
	"	<tr>" & vbNewLine & _
	"		<td width=""33%"" align=""left"" nowrap><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>" & vbNewLine & _
	"		" & getCurrentIcon(strIconFolderOpen,"","") & " <a href=""default.asp"">All Forums</a><br />" & vbNewLine & _
	"		" & getCurrentIcon(strIconBlank,"","") & getCurrentIcon(strIconBar,"","") & getCurrentIcon(strIconFolderOpenTopic,"","") & " Topics Image Preview<br /></font></td>" & vbNewLine & _
	"	</tr>" & vbNewLine & _
	"</table><br>" & vbNewLine & _
	"<table align=""center"" bgcolor=""" & strTableBorderColor & """ border=""1"" width=""100%"" cellspacing=""1"" cellpadding=""1"">" & vbNewLine & _
	"	<tr valign=""middle""><br>" & vbNewLine & _
	"		<td colspan=""2"" width=""100%"" align=""center"" bgcolor=""" & strCategoryCellColor & """>" & vbNewLine & _
	"			<font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """ color=""" & strCategoryFontColor & """><b>Last 10 Topics Image Preview</b>" & vbNewLine & _
	"			</font>" & vbNewLine & _
	"		</td>" & vbNewLine & _
	"	</tr>" & vbNewLine & _
	"	<font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """><b>" & vbNewLine
Call ChkAccess

strSql="SELECT FORUM_ID, T_STATUS, T_DATE, T_MESSAGE, T_SUBJECT, Topic_ID FROM " & strTablePrefix & "TOPICS WHERE"
if strPrivateForums = "1" and allAllowedForums <> "" and mLev < 4 then
	strSql=strSql & " (FORUM_ID IN (" & allAllowedForums & ")) AND"
end if
strSql=strSql & " T_STATUS=1 AND T_MESSAGE LIKE '%[img]%' ORDER BY T_DATE DESC"
set rsDisplay=my_Conn.Execute(strSql)
if rsDisplay.EOF or (mLev < 4 AND allAllowedForums="")then
	Response.Redirect	"default.asp"
end if
if not rsDisplay.EOF then
	rsDisplay.MoveFirst
	ii=0
	do until rsDisplay.EOF
		strMsg=rsDisplay("T_MESSAGE")
		if lcase(instr(strMsg,"[img]")) then
			ii=ii+1
			if ii=11 then
				exit do
			end if
			for i=1 to len(strMsg)
				if lcase(mid(strMsg,i,5))="[img]" then
					intj=i+5
				end if
				if lcase(mid(strMsg,i,6))="[/img]" then
					intk=i
					strImgURL=mid(strMsg,intj,intk-intj)
				end if
			next
			address = lcase(strForumURL&Trim(strImgURL))
		end if
		strTgtURL(ii)=address
		strSubj(ii)=rsDisplay("T_Subject")
		strTPID(ii)=rsDisplay("Topic_ID")
		il=0
		rsDisplay.MoveNext
	Loop
	for ij=1 to 5
		Response.Write	"	<tr height=""275"" valign=""bottom"">" & vbNewLine
		for ik=1 to 2
			il=il+1
			Response.Write	"		<td width=""50%"" align=""center"" bgcolor=""" & strForumCellColor & """>" & vbNewLine
			if strTgtURL(il)>"" then
				Response.Write	"<a href=""" & strTgtURL(il) & """ target=""_blank"">" & vbNewLine & _
					"<img src=""" & strTgtURL(il) & """ width=""298""></a><br>" & vbNewLine
			end if
			Response.Write	"<a href=""topic.asp?topic_id="& cInt(strTPID(il)) & """ target=""_blank"">" & strSubj(il) & "</a>" & vbNewLine & _
				"</td>" & vbNewLine
		next
		Response.Write	"	</tr>" & vbNewLine
	next
	rsDisplay.Close
end if
Set rsDisplay=Nothing
Response.Write	"	</table>" & vbNewLine
WriteFooter
Response.End


Sub ChkAccess
	if mlev = 3 then
		strSql = "SELECT FORUM_ID FROM " & strTablePrefix & "MODERATOR " & _
		 " WHERE MEMBER_ID = " & MemberID
		Set rsMod = Server.CreateObject("ADODB.Recordset")
		rsMod.open strSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
		if rsMod.EOF then
			recModCount = ""
		else
			allModData = rsMod.GetRows(adGetRowsRest)
			recModCount = UBound(allModData,2)
		end if
		RsMod.close
		set RsMod = nothing
		if recModCount <> "" then
			for x = 0 to recModCount
				if x = 0 then
					ModOfForums = allModData(0,x)
				else
					ModOfForums = ModOfForums & "," & allModData(0,x)
				end if
			next
		else
			ModOfForums = ""
		end if
	else
		ModOfForums = ""
	end if
	if strPrivateForums = "1" and mLev < 4 then
		allAllowedForums = ""
		allowSql = "SELECT FORUM_ID, F_SUBJECT, F_PRIVATEFORUMS, F_PASSWORD_NEW"
		allowSql = allowSql & " FROM " & strTablePrefix & "FORUM"
		allowSql = allowSql & " WHERE F_TYPE = 0"
		allowSql = allowSql & " ORDER BY FORUM_ID"
		set rsAllowed = Server.CreateObject("ADODB.Recordset")
		rsAllowed.open allowSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
		if rsAllowed.EOF then
			recAllowedCount = ""
		else
			allAllowedData = rsAllowed.GetRows(adGetRowsRest)
			recAllowedCount = UBound(allAllowedData,2)
		end if
		rsAllowed.close
		set rsAllowed = nothing
		if recAllowedCount <> "" then
			fFORUM_ID = 0
			fF_SUBJECT = 1
			fF_PRIVATEFORUMS = 2
			fF_PASSWORD_NEW = 3
			for RowCount = 0 to recAllowedCount
				Forum_ID = allAllowedData(fFORUM_ID,RowCount)
				Forum_Subject = allAllowedData(fF_SUBJECT,RowCount)
				Forum_PrivateForums = allAllowedData(fF_PRIVATEFORUMS,RowCount)
				Forum_FPasswordNew = allAllowedData(fF_PASSWORD_NEW,RowCount)
				if mLev = 4 then
					ModerateAllowed = "Y"
				elseif mLev = 3 and ModOfForums <> "" then
					if (strAuthType = "nt") then
						if (chkForumModerator(Forum_ID, Session(strCookieURL & "username")) = "1") then ModerateAllowed = "Y" else ModerateAllowed = "N"
					else
						if (instr("," & ModOfForums & "," ,"," & Forum_ID & ",") > 0) then ModerateAllowed = "Y" else ModerateAllowed = "N"
					end if
				else
					ModerateAllowed = "N"
				end if
				if chkForumAccessNew(Forum_PrivateForums,Forum_FPasswordNew,Forum_Subject,Forum_ID,MemberID) = true then
					if allAllowedForums = "" then
						allAllowedForums = Forum_ID
					else
						allAllowedForums = allAllowedForums & "," & Forum_ID
					end if
				end if
			next
		end if
		if allAllowedForums = "" then allAllowedForums = 0
	end if
End Sub
%>

'collect the image information into an array
Dim blnGfxSpex, width, height, colors, strType
intCount = 0
For Each objFile In objFS.GetFolder(".\images").Files
	'As per the readme, images need to be 'non-progressive' JPGs
	If LCase(Right(objFile.Name, 4)) = ".jpg" and intCount <= intNumOfFiles Then
		blnGfxSpex = gfxSpex((".\images\" & objFile.Name), width, height, colors, strType)
		MsgIE Now() & " - Now getting information on " & (intCount + 1) & " of " & intNumOfFiles & "."
		arrImages(intCount) = "<image>" & vbNewLine & _
								"<filename>" & objFile.Name & "</filename>" & vbNewLine & _
								"<caption></caption>" & vbNewLine & _
								"<width>" & width & "</width>" & vbNewLine & _
								"<height>" & height & "</height>" & vbNewLine & _
								"</image>" & vbNewLine
		intCount = intCount + 1
	End If
Next

':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
':::                                                             :::
':::  This routine will attempt to identify any filespec passed  :::
':::  as a graphic file (regardless of the extension). This will :::
':::  work with BMP, GIF, JPG and PNG files.                     :::
':::                                                             :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
':::          Based on ideas presented by David Crowell          :::
':::                   (credit where due)                        :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::: blah blah blah blah blah blah blah blah blah blah blah blah :::
'::: blah blah blah blah blah blah blah blah blah blah blah blah :::
'::: blah blah     Copyright *c* MM,  Mike Shaffer     blah blah :::
'::: blah blah      ALL RIGHTS RESERVED WORLDWIDE      blah blah :::
'::: blah blah  Permission is granted to use this code blah blah :::
'::: blah blah   in your projects, as long as this     blah blah :::
'::: blah blah      copyright notice is included       blah blah :::
'::: blah blah blah blah blah blah blah blah blah blah blah blah :::
'::: blah blah blah blah blah blah blah blah blah blah blah blah :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
':::                                                             :::
':::  This function gets a specified number of bytes from any    :::
':::  file, starting at the offset (base 1)                      :::
':::                                                             :::
':::  Passed:                                                    :::
':::       flnm        => Filespec of file to read               :::
':::       offset      => Offset at which to start reading       :::
':::       bytes       => How many bytes to read                 :::
':::                                                             :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
function GetBytes(flnm, offset, bytes)

 Dim objFSO
 Dim objFTemp
 Dim objTextStream
 Dim lngSize

 on error resume next

 Set objFSO = CreateObject("Scripting.FileSystemObject")
 
 ' First, we get the filesize
 Set objFTemp = objFSO.GetFile(flnm)
 lngSize = objFTemp.Size
 set objFTemp = nothing

 fsoForReading = 1
 Set objTextStream = objFSO.OpenTextFile(flnm, fsoForReading)

 if offset > 0 then
	strBuff = objTextStream.Read(offset - 1)
 end if

 if bytes = -1 then		' Get All!

	GetBytes = objTextStream.Read(lngSize)  'ReadAll

 else

	GetBytes = objTextStream.Read(bytes)

 end if

 objTextStream.Close
 set objTextStream = nothing
 set objFSO = nothing

end function


':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
':::                                                             :::
':::  Functions to convert two bytes to a numeric value (long)   :::
':::  (both little-endian and big-endian)                        :::
':::                                                             :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
function lngConvert(strTemp)
 lngConvert = clng(asc(left(strTemp, 1)) + ((asc(right(strTemp, 1)) * 256)))
end function

function lngConvert2(strTemp)
 lngConvert2 = clng(asc(right(strTemp, 1)) + ((asc(left(strTemp, 1)) * 256)))
end function


':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
':::                                                             :::
':::  This function does most of the real work. It will attempt  :::
':::  to read any file, regardless of the extension, and will    :::
':::  identify if it is a graphical image.                       :::
':::                                                             :::
':::  Passed:                                                    :::
':::       flnm        => Filespec of file to read               :::
':::       width       => width of image                         :::
':::       height      => height of image                        :::
':::       depth       => color depth (in number of colors)      :::
':::       strImageType=> type of image (e.g. GIF, BMP, etc.)    :::
':::                                                             :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
function gfxSpex(flnm, width, height, depth, strImageType)

 dim strPNG 
 dim strGIF
 dim strBMP
 dim strType
 strType = ""
 strImageType = "(unknown)"

 gfxSpex = False

 strPNG = chr(137) & chr(80) & chr(78)
 strGIF = "GIF"
 strBMP = chr(66) & chr(77)

 strType = GetBytes(flnm, 0, 3)

 if strType = strGIF then				' is GIF

	strImageType = "GIF"
	Width = lngConvert(GetBytes(flnm, 7, 2))
	Height = lngConvert(GetBytes(flnm, 9, 2))
	Depth = 2 ^ ((asc(GetBytes(flnm, 11, 1)) and 7) + 1)
	gfxSpex = True

 elseif left(strType, 2) = strBMP then		' is BMP

	strImageType = "BMP"
	Width = lngConvert(GetBytes(flnm, 19, 2))
	Height = lngConvert(GetBytes(flnm, 23, 2))
	Depth = 2 ^ (asc(GetBytes(flnm, 29, 1)))
	gfxSpex = True

 elseif strType = strPNG then			' Is PNG

	strImageType = "PNG"
	Width = lngConvert2(GetBytes(flnm, 19, 2))
	Height = lngConvert2(GetBytes(flnm, 23, 2))
	Depth = getBytes(flnm, 25, 2)

	select case asc(right(Depth,1))
	   case 0
		  Depth = 2 ^ (asc(left(Depth, 1)))
		  gfxSpex = True
	   case 2
		  Depth = 2 ^ (asc(left(Depth, 1)) * 3)
		  gfxSpex = True
	   case 3
		  Depth = 2 ^ (asc(left(Depth, 1)))  '8
		  gfxSpex = True
	   case 4
		  Depth = 2 ^ (asc(left(Depth, 1)) * 2)
		  gfxSpex = True
	   case 6
		  Depth = 2 ^ (asc(left(Depth, 1)) * 4)
		  gfxSpex = True
	   case else
		  Depth = -1
	end select


 else

	strBuff = GetBytes(flnm, 0, -1)		' Get all bytes from file
	lngSize = len(strBuff)
	flgFound = 0

	strTarget = chr(255) & chr(216) & chr(255)
	flgFound = instr(strBuff, strTarget)

	if flgFound = 0 then
	   exit function
	end if

	strImageType = "JPG"
	lngPos = flgFound + 2
	ExitLoop = false

	do while ExitLoop = False and lngPos < lngSize

	   do while asc(mid(strBuff, lngPos, 1)) = 255 and lngPos < lngSize
		  lngPos = lngPos + 1
	   loop

	   if asc(mid(strBuff, lngPos, 1)) < 192 or asc(mid(strBuff, lngPos, 1)) > 195 then
		  lngMarkerSize = lngConvert2(mid(strBuff, lngPos + 1, 2))
		  lngPos = lngPos + lngMarkerSize  + 1
	   else
		  ExitLoop = True
	   end if

   loop
   '
   if ExitLoop = False then

	  Width = -1
	  Height = -1
	  Depth = -1

   else

	  Height = lngConvert2(mid(strBuff, lngPos + 4, 2))
	  Width = lngConvert2(mid(strBuff, lngPos + 6, 2))
	  Depth = 2 ^ (asc(mid(strBuff, lngPos + 8, 1)) * 8)
	  gfxSpex = True

   end if
			   
 end if

end function