<% '//// Please note that this application is copyrighted by XIGLA SOFTWARE '//// As Stated in our license agreement, all of our copyright notices must remain visible '//// This software is licensed, not sold '//// Rebranding or resellin this application without our written permission '//// will result in legal action. '//// XIGLA SOFTWARE (http://www.xigla.com) Holds all the copyrights for this application '//// You can only use this application on the licensed site response.expires=-1 response.buffer=true title="Absolute Image Gallery XE V2.0 : Licensed to "&license todaydate=year(now)&"/"&right("0"&month(now),2)&"/"&right("0"&day(now),2) function getnavigation(catpath,page,flag) if instr(page,"?")<>0 then thisparam="&" else thisparam="?" lcatpath=replace(catpath&"","'","''") psql="select * from xlaAIGcategories where '"&lcatpath&"%' like catpath + '%' order by catpath desc;" set rs=conn.execute(psql) do until rs.eof if rs("catpath")=catpath and flag=0 then thisnode=rs("catname") else thisnode=""&rs("catname")&"" end if navbar=thisnode & " > " & navbar rs.movenext loop navbar=left(navbar,len(navbar)-6) rs.close set rs=nothing getnavigation=navbar end function function ocurrences(tpath,tname) myocurr=split(tpath,"/") for x=1 to ubound(myocurr)-1 points=points&"..." next set myocurr=nothing ocurrences=points&tname end function function preparecode(what) toprepare=what toprepare=replace(toprepare,"\","\\") toprepare=replace(toprepare,"'","\'") toprepare=replace(toprepare,vbcrlf,"\n") toprepare=replace(toprepare,"/","\/") toprepare=replace(toprepare,chr(34),"\'") preparecode=toprepare end function function gettn(whichpath,whichfile) thepath=getpath(whichpath)&"tn\"&tnprefix&whichfile thetnfile=mid(whichfile,1,instrrev(whichfile,".")-1) lookfor=mid(thepath,1,instrrev(thepath,".")-1) tnextesnions=".gif,.jpg,.bmp,.png" thepath1=lookfor &".gif" thepath2=lookfor&".jpg" thepath3=lookfor&".bmp" thepath4=lookfor&".png" theext=lcase(mid(whichfile,instrrev(whichfile,".")+1,len(whichfile))) if fs.fileexists(thepath1) then gettn=escape(whichpath&"tn/"&tnprefix&thetnfile&".gif") elseif fs.fileexists(thepath2) then gettn=escape(whichpath&"tn/"&tnprefix&thetnfile&".jpg") elseif fs.fileexists(thepath3) then gettn=escape(whichpath&"tn/"&tnprefix&thetnfile&".bmp") elseif fs.fileexists(thepath4) then gettn=escape(whichpath&"tn/"&tnprefix&thetnfile&".png") elseif imagecomponent<>"" and flytn<>"" and (theext="jpg" or theext="jpeg" or theext="bmp" or theext="png") then '/// Create Thumbnail on the Fly gettn="sendbinary.asp?ipath=" & server.urlencode(whichpath) & "&ifile="&server.urlencode(whichfile) elseif fs.fileexists(server.mappath("filetypes/")&"\"&theext&".gif") then gettn="filetypes/"&theext&".gif" else gettn="filetypes/unknown.gif" end if end function function getimage(whichimageid,whichfile,whichpath,whatsize) if whichimageid="" or not(isnumeric(whichimageid)) then whichimageid=0 Set Fs=createobject("scripting.filesystemobject") thepath=server.mappath("filetypes/") theext=lcase(mid(whichfile,instrrev(whichfile,".")+1,len(whichfile))) codepath=thepath & "\"&theext&".txt" if streamdownload="" then toread=thepath&"\unknown.txt" else toread=thepath&"\unknown2.txt" if (kblimit=0 or (kblimit>0 and whatsize/1000<=kblimit)) and fs.fileexists(codepath) then toread=codepath '/// Get Default Image Code Set a=fs.opentextfile(toread) code=a.readall a.close set a=nothing set fs=nothing if ispc<>"" and (pcsize<>"" and pcsize<>0) and (theext="jpg" or theext="png" or theext="bmp") and imagecomponent<>"" then whichpath="sendbinary.asp?ispc=1&ipath="&server.urlencode(whichpath) else whichpath=server.urlencode(whichpath) end if if instr(whichpath,"+")>0then whichpath=replace(whichpath,"+","%20") code=replace(code&"","$$URL$$",whichpath) code=replace(code&"","$$IMAGEID$$",whichimageid) getimage=code end function function isinmybox(thisimage) if enablemybox<>"" then if instr(","&mybox&",",","&thisimage&",")<>0 then boxbtn="btnMyBoxOn.gif" else boxbtn="btnMyBoxOff.gif" isinmybox="" end if end function function getsize(size) getsize=formatnumber(size/1000,2)&"Kb" end function function whichstatus(what) select case what case 1 whichstatus="Approved" case 2 whichstatus="Not Approved" case else whichstatus="Pending" end select end function function getdate(thisdate) getdate=formatdatetime(thisdate,2) end function function revertdate(thisdate) revertdate=year(thisdate)&"/"&right("0"&month(thisdate),2)&"/"&right("0"&day(thisdate),2) end function function getrating(totalratings,totalreviews) if totalreviews>0 then therating=int(totalratings/totalreviews) therating="" else therating="N/A" end if getrating=therating end function function deletefile(kill) psql="SELECT * from "&vxlaAIGimagesCategories&" where imageid="&kill set rs=conn.execute(psql) if not(rs.eof) then imagepath=getpath(rs("catpath"))&rs("imagefile") tnpath=getpath(rs("catpath")) &"tn\"&tnprefix&rs("imagename") Set Fs=createobject("scripting.filesystemobject") fs.deletefile(imagepath) if fs.fileexists(tnpath) then fs.deletefile(tnpath) set fs=nothing psql="delete from xlaAIGimages where imageid="&kill conn.execute(psql) end if rs.close set rs=nothing end function function getpath(what) getpath=gallerypath & replace(what&"","/","\") end function flytnwidth=120 vxlaAIGimagesCategories="(SELECT TOP 100 PERCENT xlaAIGcategories.catname, xlaAIGcategories.catdesc, xlaAIGcategories.supercatid, xlaAIGcategories.images, xlaAIGcategories.lastupdate, xlaAIGcategories.catpath, [catpath]+[imagefile] AS imagepath, xlaAIGimages.* FROM xlaAIGcategories INNER JOIN xlaAIGimages ON xlaAIGcategories.categoryid = xlaAIGimages.categoryid WHERE xlaAIGimages.status=1 ORDER BY xlaAIGimages.imagename, xlaAIGimages.imageid) derivedtbl " '//// Do Not Remove or modify the following code /// '//// Doing so will result in violation of the license agreement '//// The following code is required for Customer Support if request("developer")<>"" then response.write "AIGXE2.0-2002.11.16
" response.write "Licensed to :"&license&" ("&xla_id&")" response.write "
Copyright(c)2002 - Xigla Software
http://www.xigla.com" response.end end if %> <% '/// Check Gallery Lock if application("AIG_GalleryLock")<>"" then response.redirect "updatemsg.htm" action=request("action") if action="" then action="browse" set conn=server.createobject("ADODB.Connection") conn.open connection if enablemybox="" then response.cookies("xlaAIG_box").expires=date-3 mybox=request.cookies("xlaAIG_box")("mybox") box=request("box") shownew=request("shownew") slidetime=request("slidetime") if slidetime="" or not(isnumeric(slidetime)) then slidetime=defaultslidetime dim images, title,description,categories,navigation,catpath,pages function nofiles() nofiles="




No Files Found In This Category


" end function function getquery(text,categoryid,box) if box<>"" then thequery="select * from "&vxlaAIGimagesCategories&" where imageid in("&mybox&") order by imagename,imageid asc" elseif shownew<>"" then lastdate=dateadd("d",-newdays,now) lastdate=revertdate(lastdate) thequery="select * from "&vxlaAIGimagesCategories&" where imagedate>='"&lastdate&"'" else if categoryid<>"" and isnumeric(categoryid) then if categoryid=0 then condition="supercatid=0" else condition="categoryid="&categoryid thequery="select * from xlaAIGcategories where "&condition else stext=replace(text,"'","''") stext=replace(stext,"*","%") thequery="select * from "&vxlaAIGImagesCategories&" where imagename like '%"&stext&"%' or imagedesc like '%"&stext&"%' or imagefile like '%"&stext&"%' or keywords like '%"&stext&"%' or copyright like '%"&stext&"%' or credit like '%"&stext&"%'" end if end if getquery=thequery end function sub showfile() if streamdownload="" then downloadpath=chr(34)&rs("imagepath")&chr(34) & " target=_blank" else downloadpath="streamfile.asp?imageid="&rs("imageid") images="" images=images & "" images=images & "" if rs("embedhtml")<>"" then images=images&"" images=images &"
"&getimage(rs("imageid"),rs("imagefile"),rs("imagepath"),rs("imagesize"))&"" images=images &"
" images=images & "" if rs("imagedesc")<>"" then images=images & "" if rs("keywords")<>"" then images=images & "" if rs("copyright")<>"" then images=images & "" if rs("credit")<>"" then images=images & "" if rs("source")<>"" then images=images & "" if rs("datecreated")<>"" then images=images & "" if rs("uploadedby")<>"" then images=images & "" if rs("email")<>"" then images=images & "" if rs("infourl")<>"" then images=images & "" if rs("additionalinfo")<>"" then images=images & "" images=images & "" if displayhits<>"" then thishits=rs("hits") else thishits="N/A" if displayrating<>"" then thisrating=""&getrating(rs("totalrating"),rs("totalreviews"))&"" else thisrating="N/A" if enablemybox<>"" then thisbox=isinmybox(imageid) else thisbox="-" images=images & "" images=images & "" images=images & "
"&rs("imagename")&" ("&rs("imagefile")&")
"&rs("imagedesc")&"
"&rs("keywords")&"
"&rs("copyright")&"
"&rs("credit")&"
"&rs("source")&"
"&rs("datecreated")&"
"&rs("uploadedby")&"
"&rs("email")&"
"&rs("infourl")&"
"&rs("additionalinfo")&"
"&getdate(rs("imagedate"))&""&getsize(rs("imagesize"))&""&thishits&""&thisrating&""&thisbox&"
"&rs("embedhtml")&"
" title=rs("imagename") description=rs("imagedesc") catpath=rs("catpath") end sub select case action case "mybox" clear=request("clear") if clear<>"" then response.cookies("xlaAIG_box").expires=date-10 mybox="" end if if mybox="" then mybox=0 searchsql=getquery("","","on") action="browse" box="on" title="Browsing My Favorite Files" navigation="Top > Favorite Files" scriptname="gallery.asp?action=mybox" case "viewimage" text=request("text") slideshow=request("slideshow") categoryid=request("categoryid") imageid=request("imageid") direction=request("direction") if imageid="" or not(isnumeric(imageid)) then imageid=0 '/// Update Hits psql="update xlaAIGimages set hits=hits+1 where imageid="&imageid conn.execute(psql) if categoryid<>"" then psql="select * from "&vxlaAIGImagesCategories&" where categoryid="&categoryid else thesql=replace(getquery(text,"",box),"select * from","select top 100 percent imageid from") psql="select * from "&vxlaAIGImagesCategories&" where imageid in("&thesql&")" end if '/// Get Current Image /// psqlthis=psql if imageid>0 then psqlthis=psqlthis &" and imageid="&imageid psqlthis=psqlthis & " order by imagename,imageid asc" set rs=conn.execute(psqlthis) if rs.eof then response.redirect "gallery.asp" else imagename=rs("imagename") imageid=rs("imageid") call showfile() maxcount=1 end if rs.close set rs=nothing currentimgname=replace(imagename,"'","''") '/// Get Previous Image psqlprev=psql & " and (imagename<'"¤timgname&"' or (imagename='"¤timgname&"' and imageid<"&imageid&")) order by imagename desc,imageid asc" set rs=conn.execute(psqlprev) if not(rs.eof) then previmageid=rs("imageid") prevbutton=rs("Imagename") end if rs.close set rs=nothing '/// Get Next Image psqlnext=psql & " and (imagename>'"¤timgname&"' or (imagename='"¤timgname&"' and imageid>"&imageid&")) order by imagename,imageid asc" set rs=conn.execute(psqlnext) if not(rs.eof) then nextbutton=rs("imagename") nextimageid=rs("imageid") else if slideshow<>"" then psqlnext=psql & " order by imagename,imageid asc" set rs=conn.execute(psqlnext) if not(rs.eof) then nextbutton=rs("imagename") nextimageid=rs("imageid") else slideshow="" end if end if end if rs.close set rs=nothing pages="" pages=pages & "
" navigation=getnavigation(catpath,"gallery.asp",1)&" > "&imagename if slideshow<>"" then navigation=navigation & "
Slideshow Mode Refresh : Seconds
" case "browse" '/// Browse Categories categoryid=request("categoryid") if categoryid="" or not(isnumeric(categoryid)) then categoryid=0 '//// Get Category Properties //// psql=getquery("",categoryid,box) set rs=conn.execute(psql) if rs.eof then response.redirect "error.htm" catname=rs("catname") if rs("supercatid")=0 then catname="Categories" catdesc=rs("catdesc") catpath=rs("catpath") allowupload=rs("allowupload") categoryid=rs("categoryid") rs.close set rs=nothing '/// Get Subcategories psql="select * from xlaAIGcategories where supercatid="&categoryid&" order by catname" set rs=conn.execute(psql) if not(rs.eof) then c=0 do until rs.eof catlink="gallery.asp?categoryid="&rs("categoryid") filesfound=" ("&rs("images")& ")
" desc="" if rs("catdesc")&""<>"" then desc=rs("catdesc") end if c=c+1 if c=1 then newcell=newcell &"" newcell=newcell & ""&rs("catname")&""&filesfound&desc&"" newcell=newcell & " " else newcell=newcell & "" newcell=newcell & ""&rs("catname")&""&filesfound&desc&"" newcell=newcell &"" c=0 end if rs.movenext loop if c=1 then '/// Complete Table newcell=newcell & "  " end if categories="" & newcell & "
" end if rs.close set rs=nothing searchsql="select * from "&vxlaAIGImagesCategories&" where categoryid="&categoryid '/// What To Display title=catname description=catdesc scriptname="gallery.asp?action=browse&categoryid="&categoryid '/// Get Navigation Bar navigation=getnavigation(catpath,"gallery.asp",0) case "search" '//// Perform Search text=request("text") searchsql=getquery(text,"","") box="" shownew="" navigation="Search Results :" title="Search" description="
Keyword : "&server.htmlencode(text) scriptname="gallery.asp?action=search&text="&server.urlencode(text) case "new" '//// Perform Search shownew="on" box="" searchsql=getquery("","","") navigation="Files added during the last "&newdays&" days :" title="New Files" description="" scriptname="gallery.asp?action=new&shownew=on" action="browse" end select '//// Perform Search ////// if action="search" or action="browse" or action="new" then mypage=request("whichpage") if mypage="" then mypage=1 mypagesize=columns*rows set rs=server.createobject("ADODB.Recordset") rs.open searchsql,conn,1 maxval=0 maxcount=0 if not(rs.eof) then maxval=rs.recordcount rs.movefirst rs.pagesize=mypagesize maxcount=cint(rs.pagecount) rs.absolutepage=mypage howmanyrecs=0 howmanyfields=rs.fields.count-1 description=description &"
" & maxcount & " Pages - "&maxval&" Files Found" '//// Prepare Cells //// c=0 thewidth=int(100/columns) images="" for x=1 to rows images=images & "" for y=1 to columns c=c+1 images=images & "" next images=images&"" next images=images&"
["&c&"]
" redim image(mypagesize) '/// Get Images Set Fs=createobject("scripting.filesystemobject") do until rs.eof or howmanyrecs>=rs.pagesize imagedate=getdate(rs("imagedate")) imagesize=getsize(rs("imagesize")) imagename=rs("imagename") imagefile=rs("imagefile") imagedesc=rs("imagedesc") catpath=rs("catpath") thumbnail=gettn(catpath,imagefile) imageid=rs("imageid") hits=rs("Hits") rating=getrating(rs("totalrating"),rs("totalreviews")) howmanyrecs=howmanyrecs+1 image(howmanyrecs)="
" image(howmanyrecs)=image(howmanyrecs) & "
" rs.movenext loop set fs=nothing rs.close set rs=nothing '/// Pare Page Selector pages="" '//// Replace Cells for x=1 to mypagesize images=replace(images,"["&x&"]",image(x)) next else images=nofiles() end if imageid=0 end if conn.close set conn=nothing '/// Activate Page Protection if disableclick<>"" then protection="" title=title & protection end if if slideshow<>"" then slidescript="" title=title & slidescript end if if ieimagebar<>"" then title=title & "" end if '/// Prepare Buttons buttons="Go To Main Category" buttons=buttons & "New Files" if slideshow="" then offstyle="display:none" else onstyle="display:none" if maxcount>0 then buttons=buttons &"Play Slide ShowStop Slide Show" if allowupload<>"" and publicupload<>"" then buttons=buttons & "Upload File" if enablemybox<>"" then if mybox<>"0" and mybox<>"" and box<>"" then buttons=buttons & "Clear My Box Contents" if mybox<>"0" and mybox<>"" and enablesend<>"" then buttons=buttons & "Send My Box Cotents by E-mail" buttons=buttons & "View My Favorite Files" end if response.buffer=true response.flush %> <%=gallerytitle%>
<%if len(categories)>0 then%> <%end if%> <%if images<>"" then%> <%end if%> <%if pages<>"" then%> <%end if%>
<%=title%> <%=description%>


[an error occurred while processing this directive]