%@ LANGUAGE="VBSCRIPT" %>
<%
'####################################
'## Application: Blue-Collar Productions
'## File Name: igallery.asp
'## File Version: i-Gallery
'## Copyright: This code is copyrighted. Please see http://www.b-cp.com for details.
'## Notice: This code has limited warranties. Please see http://www.b-cp.com for details.
'####################################
%>
<%
Set objF = fsdir
Set objFC = objF.Files
intPage = Request.Querystring("page")
If intPage <> "" Then intPage = intPage else intPage = 0
i = 1
Dim RecordsCount
RecordsCount = 0 ' set count to zero
Dim rowcount
rowcount = 1 ' set count to zero
%>
<%
'################# SUB DisplayGallery Folder & Object Set-Up #################
Sub DisplayGallery(dirfile,f1)
'##### Begin Display Folders ######
If dirFile = "DISPLAYFOLDERS" Then
strFolderName = f1.Name
strBaseDir = BaseDir
If strBaseDir <> "" Then strBaseDir = strBaseDir Else strBaseDir = ""
%>
<%
Set tlist = f1.Files
tpf = 4
tpr = 2
tPage = 0
t = 1
tcount = 0
For Each thumbnail in tlist
If (tcount >= (tPage * tpf)) And (tcount < (tPage * tpf) + tpf) Then
If NOT InStr(thumbnail, "tn-") > 0 Then ' Hide NON-Thumnails In View
ThumbPath = UploadPath &"\"& Replace(strBaseDir,"/","\") &"\"& strFolderName &"\" & thumbnail.Name
FileExt = fExt(thumbnail.Name)
Select Case FileExt
Case "jpg", "jpeg", "gif", "bmp", "png"
'##### Folder Icon ######
If gfxSpex(ThumbPath, width, height, colors, strType) = True Then
strwidth = "37"
strheight = FormatNumber(strwidth*(height/width),0)
If strheight > 33 Then
strheight = "33"
strwidth = FormatNumber(strheight*(width/height),0)
Else
strheight = strheight
End If
Else
strwidth = 37
strheight = 33
End If
If nailer Then
strURL = URLpath&"/"& strBaseDir &"/"& strFolderName&"/tn-"&thumbnail.Name
Else
strURL = URLpath&"/"& strBaseDir &"/"& strFolderName&"/"&thumbnail.Name
End If
'##### End Folder Icon ######
strimagesrc = ""
Case "mid", "midi", "au", "aif", "aiff", "snd", "wav", "mp3", "mpga"
strimagesrc = ""
Case "avi", "mpg", "mpeg", "mov", "rm", "ram", "swf", "wmv", "qt"
strimagesrc = ""
Case Else
strimagesrc = ""
End Select
If Not t Mod tpr = 0 Then
%>
width="245"<% Else %>width="155"<% End If %> bgcolor="#f4f4f4" onMouseOver="this.bgColor='#efefef'" onMouseOut="this.bgColor='#f7f7f7'" valign="top" nowrap>
<%
End If
End If
RecordsCount = RecordsCount + 1
If rowcount = RecordsPerRow Then rowcount = 0
rowcount = rowcount + 1
i = i + 1
End If
%>
<%
'##### End Display Images ######
End If
End Sub
'################# End SUB DisplayGallery Folder & Object Set-Up #################
%>
.:: <%= GalleryVersion %> Main Folder ::.
<%
'################ Begin Display Folder & Object Layout ################
Sub iGallery
Set f = fso.GetFolder(fsDir)
Set FileList = f.subFolders
Dim emptyDir
emptyDir = TRUE
If TopLevel Then
Parent = ""
%>
<%
'On Error Resume Next
fi = 1
fpr = FoldersPerRow
For Each fn in FileList
emptyDir = FALSE
If Not LCase(fn.Name) = "_vti_cnf" AND TopLevel Then
If Not fi Mod fpr = 0 then
%>
<% DisplayGallery "DISPLAYFOLDERS",fn %>
<% Else %>
<% DisplayGallery "DISPLAYFOLDERS",fn %>
<%
End If
fi = fi + 1
End If
Next
%>
<%
Set filelist = f.Files
If Nailer Then
For Each fn in filelist
emptyDir = FALSE
DisplayGallery "DISPLAYIMAGES",fn
Next
Else
For Each fn in filelist
emptyDir = FALSE
If NOT InStr(LCase(fn.Name), "tn-") > 0 Then
DisplayGallery "DISPLAYIMAGES",fn
End If
Next
End If
%>
<%
If Request("Page") = "" Then
CurrentPage = 0
Else
CurrentPage = CInt(Request("Page"))
End If
PageCount = Round((RecordsCount/RecordsPerPage),1)
'If (PageCount > 1) Then PageCount = int(PageCount) + 1
If InStrRev(PageCount, ".") > 0 Then
DotPosition = InStrRev(PageCount, ".")
Decimal = Mid(PageCount,DotPosition + 1)
If Decimal <= 5 Then
PageCount = Round(PageCount+.5,0)
Else
PageCount = Round(PageCount,0)
End If
Else
PageCount = Round(PageCount,0)
End If
%>
<%
lastrowtotal = rowcount-1
blankspaces = RecordsPerRow - lastrowtotal
If NOT CurrentPage+1 < PageCount AND NOT TopLevel AND NOT blankspaces = RecordsPerRow Then
Select Case blankspaces
Case 1
%>
width="245"<% Else %>width="155"<% End If %> bgcolor="#f4f4f4" onMouseOver="this.bgColor='#efefef'" onMouseOut="this.bgColor='#f7f7f7'" valign="top" nowrap>
<%
Case 2
%>
width="245"<% Else %>width="155"<% End If %> bgcolor="#f4f4f4" onMouseOver="this.bgColor='#efefef'" onMouseOut="this.bgColor='#f7f7f7'" valign="top" nowrap>
width="245"<% Else %>width="155"<% End If %> bgcolor="#f4f4f4" onMouseOver="this.bgColor='#efefef'" onMouseOut="this.bgColor='#f7f7f7'" valign="top" nowrap>
<%
Case 3
%>
width="245"<% Else %>width="155"<% End If %> bgcolor="#f4f4f4" onMouseOver="this.bgColor='#efefef'" onMouseOut="this.bgColor='#f7f7f7'" valign="top" nowrap>
width="245"<% Else %>width="155"<% End If %> bgcolor="#f4f4f4" onMouseOver="this.bgColor='#efefef'" onMouseOut="this.bgColor='#f7f7f7'" valign="top" nowrap>
width="245"<% Else %>width="155"<% End If %> bgcolor="#f4f4f4" onMouseOver="this.bgColor='#efefef'" onMouseOut="this.bgColor='#f7f7f7'" valign="top" nowrap>
<%
Case 4
%>
width="245"<% Else %>width="155"<% End If %> bgcolor="#f4f4f4" onMouseOver="this.bgColor='#efefef'" onMouseOut="this.bgColor='#f7f7f7'" valign="top" nowrap>
width="245"<% Else %>width="155"<% End If %> bgcolor="#f4f4f4" onMouseOver="this.bgColor='#efefef'" onMouseOut="this.bgColor='#f7f7f7'" valign="top" nowrap>
width="245"<% Else %>width="155"<% End If %> bgcolor="#f4f4f4" onMouseOver="this.bgColor='#efefef'" onMouseOut="this.bgColor='#f7f7f7'" valign="top" nowrap>
width="245"<% Else %>width="155"<% End If %> bgcolor="#f4f4f4" onMouseOver="this.bgColor='#efefef'" onMouseOut="this.bgColor='#f7f7f7'" valign="top" nowrap>
<%
Case 5
%>
width="245"<% Else %>width="155"<% End If %> bgcolor="#f4f4f4" onMouseOver="this.bgColor='#efefef'" onMouseOut="this.bgColor='#f7f7f7'" valign="top" nowrap>
width="245"<% Else %>width="155"<% End If %> bgcolor="#f4f4f4" onMouseOver="this.bgColor='#efefef'" onMouseOut="this.bgColor='#f7f7f7'" valign="top" nowrap>
width="245"<% Else %>width="155"<% End If %> bgcolor="#f4f4f4" onMouseOver="this.bgColor='#efefef'" onMouseOut="this.bgColor='#f7f7f7'" valign="top" nowrap>
width="245"<% Else %>width="155"<% End If %> bgcolor="#f4f4f4" onMouseOver="this.bgColor='#efefef'" onMouseOut="this.bgColor='#f7f7f7'" valign="top" nowrap>
width="245"<% Else %>width="155"<% End If %> bgcolor="#f4f4f4" onMouseOver="this.bgColor='#efefef'" onMouseOut="this.bgColor='#f7f7f7'" valign="top" nowrap>
<%
End Select
End If
%>
<% If PageCount > 1 Then %>
<% If PageCount > 1 Then %>
<%= IG_pg1 %> [<%= CurrentPage+1 %> <%= IG_pg2 %> <%= PageCount %>]
<% End If %>
<%= pgHTML %>
<% End If %>
<% If TopLevel AND emptyDir Then %>
<% If Session("userLevel") = "99" OR Session("userLevel") = "98" Then %>
<%= IG_erfm1 %>
<% Else %>
<%= IG_erfm2 %>
<% End If %>
<% End If %>
<% If Session("userLevel") = "99" OR Session("userLevel") = "98" Then %>
<% If NOT TopLevel AND emptyDir AND RecordsCount = "0" Then %>
<% End If %>
<% If Nailer AND Not TopLevel AND NOT RecordsCount = "0" Then %>
<% If Session(BaseDir&"-sync") = 1 Then %><% End If %>
<% End If %>
<%
Dim CurrentDir
CurrentDir = Replace(BaseDir,"/","\")
Dim ParentDir
ParentDir = Replace(Parent,LCase(UploadPath),"")
'ParentDir = Right(ParentDir,Len(ParentDir)-1)
ParentDir = Replace(ParentDir,"\","/")
%>
<% If TopLevel Then %>
<% End If %>
<% If NOT TopLevel Then %>
<% End If %>
<% Else %>
<% If Not TopLevel AND RecordsCount = "0" Then %>
<%= IG_edm %>
<% End If %>
<% End If %>
<% If Session("userLevel") = "99" OR Session("userLevel") = "98" Then %>
<%
Directory = f
Directory = Replace(LCase(Directory),LCase(UploadPath),"")
Directory = Replace(Directory,"\\","\")
%>
<%
End Sub
'################ End Display Folder & Object Layout ################
%>
<%
'################ Create New Folder ################
Sub CreateFolder
fn = fn
fn = Replace(fn,"\","")
fn = Replace(fn,"/","")
fn = Replace(fn,":","")
fn = Replace(fn,"?","")
fn = Replace(fn,"<","")
fn = Replace(fn,">","")
fn = Replace(fn,"|","")
fn = Replace(fn,chr(42),"")
fn = Replace(fn,chr(34),"")
PathOrig = Request.QueryString("D")
PathName = PathOrig & fn
PathCurrent = Request.QueryString("C")
PathCurrent = "\"&PathCurrent&"\"
NewFolderRedirect = PathCurrent&fn&"\"
PathRename = Request.QueryString("PARENT") & fn
OldDirectory = LCase(Request.QueryString("OFOLDER"))
If Request.QueryString("PFOLDER") <> "" Then
NewDirectory = LCase(Request.QueryString("PFOLDER") &"/"& fn)
Else
NewDirectory = LCase(fn)
End If
PathParent = Request.QueryString("PARENT")
RenameFolderRedirect = PathParent&"\"&fn&"\"
If right(PathName,1) = "\" Then PathName = Left(PathName,len(PathName)-1)
Select Case UCase(Request.QueryString("T"))
Case "F" 'Create Folder
If NOT fso.FolderExists(PathName) Then
Set f = fso.CreateFolder(PathName)
response.redirect "igallery.asp?d="&URLSpace(NewFolderRedirect)
Else
response.redirect "igallery.asp?d="&URLSpace(PathCurrent)
End If
Case "R" 'Rename Folder
If fso.FolderExists(PathOrig) Then
Set f = fso.GetFolder(PathOrig)
f.Name = fn
' Batch Folder Update
Set renameConn = Server.CreateObject("ADODB.Connection")
Set RS = Server.CreateObject("ADODB.Recordset")
renameConn.Open strConnect
Set RS.ActiveConnection = renameConn
RS.CursorType = adOpenStatic
RS.LockType = adLockBatchOptimistic
SQL = "SELECT * FROM Descriptions"
SQL = SQL & " WHERE (1=1) "
RS.Open SQL,,,adCmdTable
While Not RS.EOF
If Instr(RS("folder"),OldDirectory) Then
strnewdir = Replace(RS("folder"),OldDirectory,rURLSpace(NewDirectory))
RS("folder") = rURLSpace(strnewdir)
End if
RS.MoveNext
Wend
RS.UpdateBatch
RS.close
Set RS = Nothing
' End Batch Folder Update
response.redirect "igallery.asp?d="&URLSpace(RenameFolderRedirect)
Else
response.redirect "igallery.asp?d="&URLSpace(PathCurrent)
End If
End Select
End Sub
%>
<%
'################ Begin Main Guts ################
' Root Image Directory
fsDir = LCase(UploadPath&Request("d"))
fsDir = Replace(fsDir,"\..","")
fsDir = Replace(fsDir,"..","")
If fsDir = UploadPath Then fsDir = Request.Form("fsDir")
fsRoot = LCase(UploadPath)&"\"
If Instr(fsdir,fsroot) <> 1 Then fsDir = fsRoot
If Lcase(fsDir) = Lcase(fsRoot) Then TopLevel = TRUE
' Base Image Directory
Dim BaseDir
BaseDir = Replace(Mid(fsDir,len(fsRoot),250),"\","/")
BaseDir = Left(BaseDir,Len(BaseDir)-1)
BaseDir = Right(BaseDir,Len(BaseDir)-1)
' Form Action
Action = Request.Form("POSTACTION")
PathName = Request.Form("PATHNAME")
' Delete Empty Folders
Select Case UCase(Action)
Case "DELETE"
If Request.Form("OK") = "on" Then
PathParent = Request.Form("PARENT")
If Instr(PathName,fsroot) = 1 Then
fso.DeleteFolder Left(PathName,Len(PathName)-1),TRUE
response.redirect "igallery.asp?d="&URLSpace(PathParent)&"\"
End If
End If
If Request.Form("DELETEOK") = "on" Then
If Instr(PathName,fsroot) = 1 Then
If fso.FileExists(Request.Form("PathName")) Then
Set f = fso.GetFile(Request.Form("PathName"))
f.delete
End If
End If
End If
End Select
' Choose Re-Direct
If Action <> "" Then
tstr = "igallery.asp?d="
If NOT TopLevel Then
tstr = tstr & URLSpace(fsDir)
End If
response.redirect tstr
End If
' Page Display
fn = Request.QueryString("f")
If fn = "" Then
iGallery
Else
CreateFolder
End If
'################# End Main Guts #################
%>
<%
Set objFC = nothing
Set objF = nothing
Set objFSO = Nothing
Set FSO = Nothing
Set f = Nothing
Set fsDir = Nothing
%>