Ciao Raga
avrei bisogno di un vostro aiutino,
ho scaricato simple online photo album version 2.7, uno script in asp
che consente di inserire foto e commenti (il sito è: http://www.iloire.com/vbscript/gallery_download.asp)
Mi piacerebbe poter visualizzare nei commenti oltre al nome, data, ora ecc. anche l'indirizzo Ip. Potete aiutarmi a farlo, vi prego
la pagina in asp è solo una , la seguente:
<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%
Option Explicit
Const Version="2.7"
%>
<!-- COPYRIGHT HEADER
Simple Online Photo Catalog VBScript v<%=Version%>
Author: Ivan Loire - http://www.iloire.com - ivan /at/ iloire.com
Copyright 2002-2006. All rights reserved.
Software Homepage: http://www.iloire.com/vbscript/online_photo_catalog_vbscript.asp
Software License: http://www.iloire.com/vbscript/gallery_license.asp
IMPORTANT! PLEASE READ CAREFULLY!
- This software is free to use under the GPL terms. You can use and distribute freely this code
as long as the software credits appear perfectly VISIBLE AND INTACT at the bottom frame of the gallery.
This copyright header MUST be keept intact as well.
- Removing or modifying the mentioned credits or copyright header without a license or written permission of the author
is a VIOLATION OF THE LICENSE. If you want to be able to remove them, you need to
buy a commercial license, for a small fee. More details in the script homepage.
- Some of the icons used in this application come from http://www.icon-king.com. Thx David Vignoni for
releasing them under LGPL licence.
If you would like to add comments or suggestions, rate this script or submit new layouts, go to the script homepage.
END COPYRIGHT HEADER -->
<%
'--------
'##############
'CONFIGURATION.
Const cPageTitle="Simple online photo catalog 2.7 script example" 'Page title. Change it at your will.
'IMPORTANT:
'Set the images virtual folder (with the last "/")
'Warning: The security restrictions of ASP.NET do not allow you to use ..'s to move up above the root of the application as defined in IIS.
'If you do that, thumbnails may fail to show up. Use always a relative path to your application root.
Const cVirtualPath="images/"
Const cSendEmailOnCommentAdded=true 'true or false. set this to true if you want to receive comment notifications.
Const cAdminEmail="photocatalogue@gmail.com" 'set email address to receive comment notifications.
Dim cWritableXMLCommentsFile 'Physical folder where the xml comment files are going to be written.
cWritableXMLCommentsFile=Server.Mappath(cVirtualPath) & "\comments.xml" 'Value: a valid physical folder. Must end with "\"
'cosmetic
Const cMaxThumbnailsSize=70 ' Thumbnail's width. Values: a valid integer
Const cNumberPicturesPerRowDefault=3 'set the default number of thumbails per row.
Const cimgPlus="graphics/folder.gif"
Const cimgChildNode="graphics/child.gif"
Const cimgMinus="graphics/folder_open.gif"
Const cNumberRecentComments=10
'language
'I had took language configuration out, to make easier multilingual support
%>
<!--#include file="resources.txt" -->
<%
'funcionality
Const cShowEmptyFolders=true 'If a folder doesn't contain files inside, would it be displayed?
Const cImageExtensions=".jpg,.gif,.png" 'the system would considerar files with that extension as images
Const cAllowUserChangePicturePerRow=true 'allow visitor to change the number of pictures he visualize per row
Const cAllowUserEnterComments=true 'allow visitor to add comments to the pics. You will need write access permit to comments file!
Const cHideFoldersPattern="_vti_cnf"
'thumbnail generator
'NEW in 2.6.4 use the file testthumb.aspx to check if you environment supports .NET thumbnail generation!
Const cUseThumbnailFile=true 'Values: true or false. Set to true if you are using a server page to create the thumbnail (if your server has .NET Framework installed)
Const cUseThumbnailFilePath="thumbnail.aspx" 'path to server page that will generate the thumbnail
'set here available sizes to display the big picture, separate by coma.
Const cAvailableThumbnailSizes="original,200,300,500,600" ' "original" is a reserved word
Const cDefaultThumbnailSize="original" 'set value that would appear as 'default'
'Main page text
sub WriteMainText()
'write here whatever HTML you would like to add to the main page
%>
<!--#include file="maintext.txt"-->
<%
end sub
'Image Copyright text(apply to every picture)
sub WriteCopyRightText()
%>
<!--#include file="copyright.txt"-->
<%
end sub
'Parse here the picture name as you wish, to take certain characters out of the display name, for example
function ParsePictureName(filepath)
Const maxPicNamesize=10
Dim output
output=fs.GetBaseName(filepath)
output=replace(replace(output,"_"," "),"-"," ") 'change "_" for " ", "-" for " "
if len(output)>maxPicNamesize then output=left(output,maxPicNamesize) + ".."
ParsePictureName=output
end Function
'Do whatever you want then a visitor write a comment (send and email to the admin, for example)
sub OnCommentAdded(author,email,text,picturelink)
if cSendEmailOnCommentAdded then
'lets send an email using CDONTS (be sure you have installed it in your server)
Dim objCDO
Set objCDO = Server.CreateObject("CDONTS.NewMail")
objCDO.To = cAdminEmail
objCDO.From = cAdminEmail
objCDO.Subject = "Simple online photo catalogue " & Version & " comment"
objCDO.Body = "Author: " & author & vbcrlf & _
"Email: " & email & vbcrlf & _
"Comments: " & text & vbcrlf & _
"Picture: " & vbcrlf & picturelink & _
vbcrlf & "--" & vbcrlf & cPageTitle
objCDO.Send
Set objCDO = Nothing
end if
'here you could trigger other actions when user writes a comment.
end sub
'END CONFIGURATION
'#################
'FUNCTIONS
'function to write formated output to response object.
sub prt(strValue)
response.write(strValue) & Vbcrlf
end Sub
'get XML document from file or create a new one if it doesn't exist
function GetXmlObj()
Dim objXML
Set objXML = Server.CreateObject("Microsoft.XMLDOM")
If objXML.load(cWritableXMLCommentsFile) = False Then
objXML.appendChild(objXML.createProcessingInstruction("xml","version=""1.0"" encoding=""utf-8"""))
objXML.appendChild(objXML.createElement("comments"))
End If
set GetXmlObj=objXML
end function
'BEGIN SEARCH ENGINE
'Show search engine form
sub DisplaySearch()
prt cSearchPictures
prt "<form onsubmit=""if (document.getElementById('searchbox').value=='') {alert('search for what?');document.getElementById('searchbox').focus();return false;}"" method=post target=frm_bottom action=""" & strThispage & "?action=search"">"
prt "<input type=text class=textbox id=searchbox name=search value=""" & request("search") & """>"
'prt "<input type=image src=""graphics/xmag.gif"" value=""" & cSearch & """>"
prt "<input type=submit class=button value=""" & cSearch & """>"
prt "</form>"
End sub
'Do search
Sub DoSearch()
Dim output
if len(request("search")) then
dim result,i
result=split(searchPictures(cVirtualPath,request("search")),";")
for i=0 to ubound(result) -1
output = output & (i+1) & ". " & ShowResultSearchPicture(result(i))
next
if ubound(result)=-1 then
prt "<p>" & cNoResultsFoundFor & " <strong><em>" & request("search") & "</em></strong></p>"
else
prt "<div class=searchresults>" & output & "</div>"
end if
end if
End Sub
'search engine
function searchPictures(Item, filter)
Dim folder,subfolder,file
set folder = fs.GetFolder(Server.MapPath(Item))
For each subfolder in folder.SubFolders
'aj added exclusion 16/August/2005
if instr(1,subfolder.name ,cHideFoldersPattern,1)= 0 then searchPictures= searchPictures & searchPictures(Item & subfolder.Name & "/",filter)
next
for each file in folder.Files
if (len(filter)=0 or instr(1,file.Path,filter,1)>0) and instr(1,cImageExtensions,fs.GetExtensionName(file.path),1)>0 then searchPictures=searchPictures & Item & file.Name & ";"
next
end function
'END SEARCH ENGINE
'Display recent comments
'IDEA: Eliram Haklay
Sub displayRecentComments ()
Dim commentsList,objXML,comment,objXMLcomment,i,startPos,tempWriter
Set objXML = GetXmlObj()
set commentsList=objXML.selectNodes("/comments/comment") 'we could be using xPath with position()< cNumberRecentComments if we were using MSXML2.DOMDocument.4.0
If commentsList.length > 0 Then
startPos=commentsList.length - cNumberRecentComments
If startPos<0 Then startPos=0
For i = commentsList.length-1 to startPos step -1
Set comment=objXML.childnodes(1).childnodes(i)
Prt "<strong>" & cFileName & "</strong> " & comment.childnodes(4).text & "<br />"
Prt "<div class=recentpicture>"
prt ShowResultPicture(comment.childnodes(4).text)
prt "</div>"
Prt "<div class=recentcomment>"
Prt FormatCommentsToDisplay(comment)
prt "</div><hr style=""clear:both;"">"
Next
End If
End Sub
'Show picture as result (used in search engine and recent comments display)
function ShowResultPicture(path)
Dim output
if cUseThumbnailFile Then
tempWriter=cUseThumbnailFilePath & "?ForceAspect=false&Height=" & cMaxThumbnailsSize & "&Width="& cMaxThumbnailsSize & "&image=" & Server.URLencode(path)
else
tempWriter=path
End If
output= "<center>"
output= output & "<a target=frm_bottom href=""?action=displayimage&item=" & Server.URLencode(path) & """>" &_
"<img alt=""" & ParsePictureName(path) & """ border=0 width=""" & cstr(cMaxThumbnailsSize) & """ src="""& tempWriter & """ />" &_
"</a> <br />"
output= output & "<a target=frm_bottom href=""?action=displayimage&item=" & Server.URLencode(path) & """ />" &_
cViewImage & "</a> - "
output= output & "<a target=frm_files href=""?action=displayfiles&item=" & Server.URLencode(fs.GetParentFolderName(path) & "/") & """>"
output= output & cViewFolder
output= output & "</a>"
output= output & "</center>"
ShowResultPicture=output
end function
'format comment output from comment XML comment node
function FormatCommentsToDisplay(comment)
Dim output
output= "<div class=comment><span class=name>"
If Len(comment.childnodes(1).text) then 'display obfuscated email
output= output & "<a href=""mailto:" & replace(Server.HtmlEncode(comment.childnodes(1).text),"@","/at/") & """>" & Server.HtmlEncode(comment.childnodes(0).text) & "</a>"
else
output= output & Server.HtmlEncode(comment.childnodes(0).text)
end if
output= output & "</span>, " & cOn & " <span class=date>" & Server.HtmlEncode(comment.childnodes(3).text) & "</span> " & cSaid
output= output & "<div class=commentcontent>" & replace(Server.HtmlEncode(comment.childnodes(2).text),chr(10),"<br/>") & "</div>"
output= output & "</div>"
FormatCommentsToDisplay=output
end function
'Show individual picture as search result
function ShowResultSearchPicture(path)
Dim objXml,commentsList,comment,output
output= replace(path,request("search"),"<span class=marked>" & request("search") & "</span>",1,-1,1) & "<br />"
output= output & "<div class=recentpicture>"
output= output & ShowResultPicture(path)
output= output & "</div>"
Set objXML = GetXmlObj()
set commentsList=objXML.selectNodes("/comments/comment[path=""" & path & """]")
if commentsList.length>0 then
for each comment in commentsList
output= output & "<div class=recentcomment>"
output= output & FormatCommentsToDisplay(comment)
output= output & "</div>"
next
end if
output= output & "<hr style=""clear:both"" />"
set objXML=nothing
ShowResultSearchPicture=output
end function
'Gets "next" picture file name
'IDEA: Eliram Haklay
Function FindTheNext (FileName)
Dim File,folder,foundFile,theNextFile
Set folder = fs.GetFolder(Server.MapPath(fs.GetParentFolderName(FileName)))
foundFile=0
For each File in folder.Files
If instr(1,cImageExtensions,fs.GetExtensionName(File.path),1)>0 then
If foundFile=1 Then
FindTheNext = File.Name
foundFile=0
Exit Function
Else
If File.Name=fs.GetFileName(FileName) Then
foundFile=1
End If
End If
End If
Next
FindTheNext=""
End Function
'Gets "previous" picture file name
'IDEA: Eliram Haklay
Function FindThePrev (FileName)
Dim File,foundFile,theNextFile
Dim folder: set folder = fs.GetFolder(Server.MapPath(fs.GetParentFolderName(FileName)))
theNextFile=""
For each File in folder.Files
If instr(1,cImageExtensions,fs.GetExtensionName(File.path),1)>0 then
If File.Name=fs.GetFileName(FileName) Then
FindThePrev=theNextFile
Exit Function
Else
theNextFile=File.Name
End If
End If
Next
FindThePrev=""
End Function
Sub UserCommentsEngine ()
Dim link,commentsList,objXML,comment,objXMLcomment
Set objXML = GetXmlObj()
link="?action=displayimage&Item=" & Server.URLencode(request("Item"))
Prt "<div class=comments id=visitor><h2>" & cVisitorComments & "</h2>"
Prt "<div class=body>"
'Save comment author details for other comments in the same session
if len(request("author"))> 0 then Session("author")=request("author")
if len(request("email"))> 0 then Session("email")=request("email")
If len(request("text"))>0 and len(request("author"))>0 then 'author and text fields required
' write comment
Set objXMLcomment = objXML.createElement("comment")
objXMLcomment.appendChild(objXML.createElement("author"))
objXMLcomment.appendChild(objXML.createElement("email"))
objXMLcomment.appendChild(objXML.createElement("text"))
objXMLcomment.appendChild(objXML.createElement("date"))
objXMLcomment.appendChild(objXML.createElement("path"))
objXMLcomment.appendChild(objXML.createElement("image"))
objXMLcomment.childNodes(0).text = request("author")
objXMLcomment.childNodes(1).text = request("email")
objXMLcomment.childNodes(2).text = request("text")
objXMLcomment.childNodes(3).text = now()
objXMLcomment.childNodes(4).text = request("item")
objXML.documentElement.appendChild(objXMLcomment.cloneNode(True))
on error resume next
objXML.save(cWritableXMLCommentsFile)
if err.number<>0 then
Prt ("<div class=error>" & cErrorSavingCommentTo & " <i>" & cWritableXMLCommentsFile & "</i>.<br><br>" & cErrorMessage & " " & err.Description & "</div>")
else
Call OnCommentAdded(request("author"),request("email"),request("text"),"http://" & Request.ServerVariables("server_name") & Request.ServerVariables("URL") & "?" & Request.querystring)
Prt ("<div class=success>" & cCommentAdded & "</div>")
end if
on error goto 0
end if
'read
set commentsList=objXML.selectNodes("/comments/comment[path=""" & request("item") & """]")
for each comment in commentsList
prt FormatCommentsToDisplay(comment)
Next
'write form
prt "<form id=""formComment"" method=post action=""" & strThispage & link &"""><table border=0>"
prt "<tr><td>" & cYourName & "*</td><td><input class=textbox type=text name=author value="""& session("author") & """><br></td></tr>"
prt "<tr><td>" & cYourEmail & "</td><td><input class=textbox type=text name=email value="""& session("email") & """><br></td></tr>"
prt "<tr><td>" & cComments & "*</td><td><textarea class=textbox name=text cols=30 rows=5></textarea></td></tr>"
prt "<tr><td> </td><td><input class=button type=submit value=""" & cPostYourComments & """></td></tr></table>"
prt "</form>"
Prt "</div></div>"
End Sub
Function GetComment (PictureName)
'getting the text from the comment file (if exists)
Dim fl:fl=Server.MapPath(replace (picturename, fs.GetExtensionName(picturename),"txt"))
If fs.FileExists(fl) then
Dim file: set File = fs.OpenTextFile(fl, 1)
GetComment = File.ReadAll
File.Close
End If
set File=nothing
End Function
'Create thumbnails output for a particular virtual path
Sub DisplayFiles(VirtualPath)
' Read Comments file to see if there are any comments for this folder
Dim commentsList,objXML,comment,objXMLcomment,foundComments,commentFiles,cArray,cA
Dim File,Folder,iRow, FileName,nImages,output,i
Set objXML = GetXmlObj()
Set commentsList=objXML.childnodes(1).childnodes
commentFiles=""
foundComments=0
for each comment in commentsList
If fs.GetParentFolderName(comment.childnodes(4).text) + "/"= VirtualPath Then
foundComments=foundComments+1
commentFiles=commentFiles & "," & fs.GetFileName(comment.childnodes(4).text)
End If
Next
cArray = Split(commentFiles, ",")
Set folder = fs.GetFolder(Server.MapPath(VirtualPath))
iRow=0
nImages=0
output = output & "<img src=graphics/has_author_comments.gif>: " & cAComments & " / "
output = output & "<img src=graphics/has_visitor_comments.gif>: " & cVComments & "<br>"
'output=output & "<table cellpadding=0 cellspacing=0 border=1 class=files align=center width=""98%"">"
For each File in folder.Files
If instr(1,cImageExtensions,fs.GetExtensionName(File.path),1)>0 then
nImages=nImages+1
'If iRow=0 then output=output & "<tr class=ThRow>"
'output=output & "<td valign=top align=center>"
output= output & "<div style=""margin:2px;float:left;position:relative;text-align:center"">"
output=output & "<a target=frm_bottom href=""?action=displayimage&item=" & Server.URLencode(VirtualPath & File.Name) & """>"
if (fs.FileExists(replace(File.path, fs.GetExtensionName(File.path),"txt")))=true Then
output= output & "<img border=0 style=""position:absolute;top:5px;left:15px;"" src=""graphics/has_author_comments.gif"" title=""" & cAComments & """>"
end if
For each cA in cArray
If cA=File.Name Then
output= output & "<img border=0 style=""position:absolute;top:5px;left:25px;"" src=""graphics/has_visitor_comments.gif"" title=""" & cVComments & """>"
Exit For
End If
Next
if cUseThumbnailFile then
tempWriter=cUseThumbnailFilePath & "?ForceAspect=false&Height=" & cMaxThumbnailsSize & "&Width="& cMaxThumbnailsSize & "&image=" & Server.URLEncode(VirtualPath & File.Name)
output=output & "<img class=th alt=""" & ParsePictureName(File.path) & """ border=0 src="""& tempWriter & """>"
else
output=output & "<img class=th alt=""" & ParsePictureName(File.path) & """ border=0 width=""" & cstr(cMaxThumbnailsSize) & """ src="""& VirtualPath & File.Name & """>"
end if
output=output & "<br/>" & ParsePictureName(File.path) & "</a>"
output=output & "</div>"
'output=output & "</td>"
'If cint(iRow)=cint(session("picsperrow")-1) then
'iRow=0
'output=output & "</tr>"
'Else
'iRow=iRow+1
'End If
End if
Next
'output=output & "</table>"
Prt "<div class=top>"
Prt "<b>" & Folder.name & "</b> <span class=P>[" & nImages & " " & cImagesShort & "] [" & foundComments & " " & cCommentsShort & "]</span>"
'if cAllowUserChangePicturePerRow then Prt"<form target=frm_files method=post action=""" & strThispage & "?action=displayfiles&item="& Server.URLencode(virtualpath) & """>" & cPicsPerRow & " <input name=picsperrow class=textbox type=text maxlength=3 size=2 value=""" & session("picsperrow") & """><input type=submit value="""& cChange & """ class=button></form>"
Prt "</div>"
if nImages= 0 then
Prt "<p>" & cThisFolderHasNoImages & "</p>"
else
Prt output
end if
Set folder=nothing
End Sub
'get subfolders from folder (recursive)
Sub DisplaySubFolders(Item)
Dim subfolder,folder, parentfolder,linktext, preHtml, nImages, File
set folder = fs.GetFolder(Server.MapPath(Item))
If folder.subfolders.count > 0 then
Prt "<ul>"
For each subfolder in folder.SubFolders
if instr(1,subfolder.name ,cHideFoldersPattern,1)= 0 then
'counting number of valid images in current folder
nImages=0
For each File in subfolder.Files
If instr(1,cImageExtensions,fs.GetExtensionName(File.path),1)>0 then nImages=nImages+1
Next
preHtml="<img src=""" & cimgChildNode & """>"
IDcounter=IDcounter+1
linktext=" <a onclick=""SetDisplay('" & IDcounter & "','','" & cimgMinus & "');"" target=frm_files href=""?action=displayfiles&item="& Server.URLencode(Item & subfolder.Name) & "/"">" & subfolder.name &"</a>"
if (subfolder.SubFolders.Count > 0) or (nImages > 0) or cShowEmptyFolders=true then
tempWriter=""
if nImages > 0 then
tempWriter="<span class=S1> (" & nImages & " " & cImagesShort & ", " & Round(subfolder.Size/1024) & " Kb.)</span>"
end if
if subfolder.SubFolders.count > 0 then
preHtml = "<a href=""Javascript:void(0)"" onclick=""ToogleDisplay(" & IDcounter & ");"">"
preHtml = preHtml + "<img border=0 id=""i" & IDCounter & """ src=""" & cimgPlus & """></a>"
tempWriter=tempWriter & "<span class=S> [" & subfolder.SubFolders.count & " " & cSub & "]</span>"
elseif subfolder.Files.Count = 0 then
If tempWriter="" Then
tempWriter=" " & cEmpty
End If
end if
Prt "<li>" & preHtml & linktext & tempWriter & "<div style=""display:none"" id=""l" & IDcounter & """>"
DisplaySubFolders(Item & subfolder.Name &"/")
Prt "</div>"
end if
end if
Next
Prt "</ul>"
end if
End Sub
Sub CreateFramesBody()
%>
<frameset border="0" frameborder="0" rows="79,*">
<frame frameborder=0 name=frm_header scrolling=no src="?action=title">
<frameset cols="27%,*" border="0" frameborder="0">
<frameset rows="30%,*,54" border="0" frameborder="0">
<frame frameborder=no bordercolor="#e48423" name=frm_folders scrolling=Auto src="?action=displayfolders">
<frame FRAMEBORDER="no" BORDER="0" name=frm_files src="?action=empty">
<frame FRAMEBORDER="no" BORDER="0" name=frm_search scrolling=no src="?action=search">
</frameset>
<frameset rows="*,25" frameborder=yes border=1>
<frame FRAMEBORDER="no" BORDER="0" name=frm_bottom scrolling=Auto src="?action=start">
<frame FRAMEBORDER="no" BORDER="0" name=frm_filesd src="?action=copyright"><!-- Removing or modifying this line without a license is an illegal action-->
</frameset>
</frameset>
</frameset>
<%
End Sub
sub displayMainImage()
'create resize image select box
Dim selectHtml,i,theNext,thePrev
selectHtml="<select name=targetimgsize onchange=""document.getElementById('formChangeSize').submit()"">"
for i=0 to ubound(sizeValues)
if (cstr(sizeValues(i)) = "original") and (cstr(session("targetimgsize"))=cstr(sizeValues(i))) then 'original item and current value
selectHtml=selectHtml& "<option selected value=""original"">original</option>"
elseif cstr(sizeValues(i)) = "original" then
selectHtml=selectHtml& "<option value=""original"">original</option>"
elseif cstr(session("targetimgsize"))=cstr(sizeValues(i)) then 'current one
selectHtml=selectHtml& "<option selected value=""" & sizeValues(i) & """>" & sizeValues(i) & "px</option>"
else
selectHtml=selectHtml& "<option value=""" & sizeValues(i) & """>" & sizeValues(i) & "px</option>"
end if
next
selectHtml=selectHtml & "</select>"
'end select box creation
if cUseThumbnailFile and cstr(session("targetimgsize"))<>"original" then
tempWriter=cUseThumbnailFilePath & "?ForceAspect=False&Width=" & session("targetimgsize") & "&Height=" & session("targetimgsize") & "&image=" & Server.URLEncode(request("item"))
else : tempWriter=request("item"): end if
Prt "<center>"
Prt "<div class=MainImage>"
Prt "<div class=MainImageDim>"
Prt "<table width=100% border=0 cellpadding=0 cellspacing=0><tr><td>"
thePrev=FindThePrev (request("item"))
If len(thePrev) Then Prt "<a class=arrow target=frm_bottom href=""?action=displayimage&item=" & Server.URLencode(fs.GetParentFolderName(request("item")) & "/" & thePrev) & """>" & " <img border=""0"" title=""" & cPrevPicText & """ alt=""" & cPrevPicText & """ src=""graphics/1leftarrow.gif"" /></a>"
Prt "</td><td align=center>"
Prt cFileName & " <b>" & fs.GetFilename(request("item")) & "</b>"
if cUseThumbnailFile then Prt " - <form style=""display:inline"" id=""formChangeSize"" method=post action=""" & strThispage & "?action=displayimage&item=" & Server.URLencode(request("item")) & """>" & cSetMaximumsize & " " & selectHtml & "</form>"
Prt "</td><td align=right>"
theNext=FindTheNext (request("item"))
If len(theNext) Then Prt "<a class=arrow target=frm_bottom href=""?action=displayimage&item=" & Server.URLencode(fs.GetParentFolderName(request("item")) & "/" & theNext) & """><img border=""0"" title=""" & cNextPicText & """ alt=""" & cNextPicText & """ src=""graphics/1rightarrow.gif"" /></a>"
Prt "</td></tr></table>"
Prt "</div>"
Prt ("<img id=""MainImage"" alt=""" & fs.GetFilename(request("item")) & """ src=""" & tempWriter & """>")
WriteCopyRightText()
'comments
tempWriter=GetComment (request("item"))
if len(tempWriter)>0 then Prt "<div class=comments id=author><h2>" & cAuthorComments & "</h2><div class=body>" & tempWriter & "</div></div>"
if cAllowUserEnterComments then Call UserCommentsEngine()
Prt "</div>"
Prt "</center>"
end sub
'END FUNCTIONS
'MAIN
On error resume next 'comment this line for debugging purposes
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
Dim strThispage 'important to avoid 405 errors in "post"
strThispage= Request.ServerVariables ("SCRIPT_NAME")
Dim sizeValues
sizeValues = split(cAvailableThumbnailSizes,",") 'converting valid image values to array
Dim tempWriter 'use to store temporal values along the script
Dim IDcounter 'to assing unique ID's
IDcounter=0
if isnumeric(request("picsperrow")) and len(request("picsperrow")) > 0 then session("picsperrow")=cint(request("picsperrow"))
if not isnumeric(session("picsperrow")) or len(session("picsperrow"))=0 then session("picsperrow")=cNumberPicturesPerRowDefault
if len(request("targetimgsize")) > 0 then session("targetimgsize")=request("targetimgsize")
if len(session("targetimgsize"))=0 then session("targetimgsize")=cDefaultThumbnailSize
%>
<html>
<head>
<title><%=cPageTitle%></title>
<link rel="stylesheet" href="css/online_photo_catalog_vbscript.css" type="text/css">
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
<script language=javascript>
function SetDisplay(elementid,displayvalue,imgsrc){
if (document.getElementById('i' + elementid) !=null) document.getElementById('i' + elementid).src=imgsrc;
document.getElementById('l' + elementid).style.display=displayvalue;
}
function ToogleDisplay(elementid){
//alert(document.getElementById(elementid).style.display);
if (document.getElementById('l' + elementid).style.display=='none'){ //it is contracted
SetDisplay(elementid,'','<%=cimgMinus%>');
}
else{
SetDisplay(elementid,'none','<%=cimgPlus%>');
}
}
</script>
</head>
<%
Select case request("action")
case "displayfolders"
Prt("<body class=folders>")
DisplaySubFolders(cVirtualPath)
Prt("</body>")
case "displayfiles"
Prt("<body class=files>")
Call DisplayFiles(request("item"))
Prt("</body>")
Case "recent"
Prt("<body class=image>")
displayRecentComments
Prt("</body>")
case "title"
Prt "<body class=title>"
%>
<!--#include file="header.txt"-->
<%
Prt "<table width=100% cellpadding=0 cellspacing=0>"
Prt "<tr>"
Prt "<td class=titlebar align=right>"
If (cNumberRecentComments > 0) and (cAllowUserEnterComments=true) Then Prt("<a target=frm_bottom href=""" & strThispage & "?action=recent"">" & cNumberRecentComments & " " & cRecentComments & "</a> | ")
Prt"<a target=frm_bottom href=""" & strThispage & "?action=start"">" & cGalleryHome & "</a> | "
'Script credits. To remove this, you need to buy a commercial license.
Prt "<a target=frm_bottom href=""http://www.iloire.com/vbscript/online_photo_catalog_vbscript.asp?ref=" & version & """>" & cScriptHomepage & "</a>"
Prt "</td></tr></table>"
Prt "</body>"
case "start"
Prt "<body>"
WriteMainText()
Prt("</body>")
case "empty"
case "search"
Prt("<body class=search>")
displaysearch
dosearch
Prt("</body>")
case "displayimage"
Prt "<body class=image>"
DisplayMainImage
Prt "</body>"
case "copyright"
'ALERT: Removing or modifying this part without a license is an illegal action. Visit the software homepage in order to purchase a license.
%>
<body class=copyright style="margin:0px">
<div>
Created with the free software <a title="Free simple online photo catalogue (image gallery)" href="http://www.iloire.com/vbscript/online_photo_catalog_vbscript.asp?ref=<% =version%>">Simple Online Photo Catalogue image gallery</a>
</div>
<%
Prt "</body>"
case else
CreateFramesBody
End select
Set fs=nothing
if err then
Prt "<p class=error>Error: " & err.description + ".</p>"
end if
%>
</html>
