<%=cPageTitle%>

<%@ LANGUAGE="VBScript"%> <% Option Explicit Sub ShowCredits() %> <% End Sub '-------- 'What's new in v2.0? '1) Now this script allows comments. ' If you want to add comments for a pic, only put in the same folder of the pic a text file with your comments in it. ' The text file must have the same name of the picture and the extension : .txt. ' Ej: pic: bertin_in_the_beach.jpg; text file with comments (located in the same folder): bertin_in_the_beach.txt '2) Cosmetic change ' Now with the folder icon 'What's new in v2.1? '1) Allow visitor change number of pics per row. '2) Allow visitor to enter comments (xml format) '3) Cosmetic changes '--------------------- 'CONFIGURATION. EDIT ONLY THIS PART '=========================================================================================================== Const cVirtualPath="/Galleries/Birds/" 'THIS IS THE IMAGES FOLDER TO EDIT Const cPageTitle="Birds Gallery" 'THIS IS THE PAGE TITLE TO EDIT '=========================================================================================================== Const cWidthThumbnails=100 '40 ' Thumbnail's width Const cFirstPageText="Welcome to my Galleries.
Select a folder from the list above and the thumbnails will be displayed here. Clicking a thumbnail will open the main image to the right" Const cNumberPicturesPerRowDefault=1 'set the default number of thumbails per row. Const WritableXMLCommentsFolder="d:\html\users\iloirecom\xml\comments\" Const cAllowUserEnterComments=false 'true 'allow visitor to add comments to the pics. You will need write access permit to comments file! Const cAllowUserChangePicturePerRow=false 'allow visitor to change the number of pictures he visualize per row 'END CONFIGURATION Dim strThispage strThispage= Request.ServerVariables ("SCRIPT_NAME") Sub UserCommentsEngine () Dim link,commentsList,objXML,comment,objXMLcomment,FileLocation FileLocation=WritableXMLCommentsFolder & replace(request("Filename"), right(request("Filename"),4),".xml") 'FileLocation=Server.MapPath(replace(request("Item"), right(request("Item"),4),".xml")) Set objXML = Server.CreateObject("Microsoft.XMLDOM") If objXML.load(Filelocation) = False Then objXML.appendChild(objXML.createProcessingInstruction("xml","version=""1.0""")) objXML.appendChild(objXML.createElement("comments")) End If link=strthispage & "?action=displayimage&Filename=" & request("Filename") & "&Item=" & request("Item") 'create html code to enter comments if request("write")="yes" then prt "" else If len(request("text"))>0 then 'write Set objXMLcomment = objXML.createElement("comment") objXMLcomment.appendChild(objXML.createElement("author")) objXMLcomment.appendChild(objXML.createElement("text")) objXMLcomment.appendChild(objXML.createElement("date")) objXMLcomment.childNodes(0).text = request("author") objXMLcomment.childNodes(1).text = request("text") objXMLcomment.childNodes(2).text = now() objXML.documentElement.appendChild(objXMLcomment.cloneNode(True)) objXML.save(FileLocation) Prt ("Comment added!!") end if prt "
" End if 'read If objXML.load(FileLocation) then prt "

" Set commentsList=objXML.childnodes(1).childnodes for each comment in commentsList prt "» " & comment.childnodes(0).text & ", on " & comment.childnodes(2).text & " said:" prt "

" & comment.childnodes(1).text & "

" next prt "

" end if End Sub Function GetComment (PictureName) 'this is the new function for the v1.1 'getting the text from the comment file (if exists) Dim fso,FileLocation, File Dim myText dim model Set fso = CreateObject("Scripting.FileSystemObject") FileLocation=Server.MapPath(replace (picturename, right(picturename,8),".txt")) If fso.FileExists(FileLocation) then set File = fso.OpenTextFile(FileLocation, 1) ' GetComment = File.ReadAll ' the original which reads the whole file myText = File.ReadLine ' image number GetComment = myText ' File.SkipLine File.SkipLine File.SkipLine myText = " " ' blank line GetComment = GetComment + "
" + myText myText = "----------------------------------------------------------------------------------------------- " ' underline GetComment = GetComment + "
" + myText myText = " " ' blank line GetComment = GetComment + "
" + myText myText = File.ReadLine ' camera model GetComment = GetComment + "
" + myText ' GetComment = myText do while left(myText,4)<> "Date" ' File.SkipLine myText = File.ReadLine ' date/time loop GetComment = GetComment + "
" + myText myText = File.ReadLine ' shutter GetComment = GetComment + "
" + myText myText = File.ReadLine ' aperture GetComment = GetComment + "
" + myText do while left(myText,3)<> "ISO" myText = File.ReadLine ' ISO loop GetComment = GetComment + "
" + myText myText = File.ReadLine ' lens GetComment = GetComment + "
" + myText myText = File.ReadLine ' focal length GetComment = GetComment + "
" + myText Else GetComment = "" End If End Function Sub DisplayFiles(VirtualPath) Dim File,Folder,iRow Set folder = fs.GetFolder(Server.MapPath(VirtualPath)) ' IF INFO FILE IS FOUND DISPLAY IT, OTHERWISE SHOW A DEFAULT PAGE. For each File in folder.Files If (lcase(right(File.path, 8)) = "info.htm") then Prt("") Exit For Else Prt("") Exit For End if Next Prt "") if cAllowUserChangePicturePerRow=true then Prt("Pics per row:") Prt "

" if cAllowUserChangePicturePerRow=true then Prt("

" Prt("") Prt("") iRow=0 For each File in folder.Files ' If (lcase(right(File.path, 7)) = "thm.jpg") then If (lcase(right(File.path, 4)) = ".jpg") then If iRow=0 then Prt("") ' Prt ("") ' Prt ("") Prt ("") If cint(iRow)=cint(session("picsperrow")-1) then iRow=0 Prt("") Else iRow=iRow+1 End If End if Next if Folder.Files.Count=0 then Prt("

This folder is empty.

") Prt("") End if Prt("

file

") Prt("") End Sub Sub Display(Item) Dim subfolder,folder set folder = fs.GetFolder(Server.MapPath(Item)) Prt "

" & subfolder.name &"" Display(Item & subfolder.Name &"/") end if Next End if Prt "

" End Sub Sub prt(strValue) response.write(strValue) & Vbcrlf End Sub Sub CreateFramesBody() Prt("") Prt("") Prt("") Prt("") Prt("") Prt("") Prt("") Prt("") Prt("") Prt("") End Sub if len(request("picsperrow")) > 0 then session("picsperrow")=cint(request("picsperrow")) if session("picsperrow")="" then session("picsperrow")=cNumberPicturesPerRowDefault %> <%=cPageTitle%> <% Dim fs Set fs = CreateObject("Scripting.FileSystemObject") ShowCredits() Select case request("action") case "displayfolders" Prt("

") Display(cVirtualPath) Prt("

") case "displayfiles" Prt("") ' This Line is to sort out setting a new main page every time a folder is opened. IT DOES WORK!!!! ' Prt("") Call DisplayFiles(request("item")) Prt("") case "start" Prt("

") Prt(cFirstPageText) Prt("

") case "title" Prt("") Prt("" & cPageTitle & "
") Prt "" ' EDIT THE URL HERE TO POINT TO THE FLASH VERSION IF NEEDED, IF IT'S ALWAYS INDEX.HTML THEN NO NEED TO EDIT '=========================================================================================================== Prt "" '=========================================================================================================== Prt "

" Prt("") case "empty" Prt("") case "displayimage" Prt("") Prt("") Prt ("

") Prt("
") Prt ("

") Prt(" & request(

& request(

") Prt("") Prt("

") ' MODIFIED TO ONLY DISPLAY FILENAME IF IT ISN'T THE FOLDER INFO PAGE if request("Filename") <> "00-folder_info_std.jpg" then Prt "

File name: " & request("Filename") & "

" ' MODIFIED TO ONLY DISPLAY Author Comments header IF IT ISN'T THE FOLDER INFO PAGE if request("Filename") <> "00-folder_info_std.jpg" then Prt ("

Author comments

") Else Prt ("

") End If Prt "

" & GetComment (request("item")) & "

" if cAllowUserEnterComments then Prt "

Visitor Comments

" if cAllowUserEnterComments then Call UserCommentsEngine() if cAllowUserEnterComments then Prt ("

") Prt ("

") Prt("") Prt("") case else CreateFramesBody End select Set fs=nothing %>