<%@ 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) 'response.Write(dirFile) '##### 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 %> <% Else %> <% End if End If tcount = tcount + 1 t = t + 1 End If Set Jpeg = Nothing If tcount > 3 Then Exit For Next %>
\"><%= strimagesrc %>
\"><%= strimagesrc %>

\"><%= f1.name %>
<% '##### End Display Folders ###### '##### Begin Display Images ###### ElseIf dirFile = "DISPLAYIMAGES" Then strBaseDir = BaseDir If strBaseDir <> "" Then strBaseDir = strBaseDir Else strBaseDir = "" If NOT InStr(f1, "tn-") > 0 AND NOT InStr(LCase(f1), "thumbs.db") > 0 Then ' Hide Non-Thumnails & Thumbs.db In View '##### Original Image Size ###### 'FileExt = fExt(f1.Name) 'Select Case FileExt 'Case "jpg", "jpeg", "gif", "bmp", "png" 'ImagePath = UploadPath &"\"& strImageFolder &"\" & strimage 'If gfxSpex(Replace(f1.Path,"tn-",""), width, height, colors, strType) = True Then 'ImageWidth = width 'ImageHeight = height 'End If 'End Select If Nailer Then 'If ImageWidth > 145 Then strwidth = "145" 'strheight = Round(145*ImageHeight/ImageWidth,0) strimagesrc = "" 'Else 'strwidth = ImageWidth 'strHeight = ImageHeight 'strimagesrc = "" 'End If Else 'If ImageWidth > 145 Then strwidth = "145" 'strheight = Round(145*ImageHeight/ImageWidth,0) 'Else 'strwidth = ImageWidth 'strHeight = ImageHeight 'End If strimagesrc = "" End If If (RecordsCount >= (intPage * RecordsPerPage)) and (RecordsCount < (intPage * RecordsPerPage) + RecordsPerPage) Then If NOT i MOD RecordsPerRow = 0 Then strImageName = f1.name QS = "?image="&URLSpace(Replace(strImageName,"tn-",""))&"&folder="&URLSpace(BaseDir)&"&page="&intPage %> width="245"<% Else %>width="155"<% End If %> bgcolor="#f4f4f4" onMouseOver="this.bgColor='#efefef'" onMouseOut="this.bgColor='#f7f7f7'" valign="top" nowrap> <% Else strImageName = f1.name QS = "?image="&URLSpace(Replace(strImageName,"tn-",""))&"&folder="&URLSpace(BaseDir)&"&page="&intPage %> 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 ################# %> .:: MCA Gallery ::.

<% '################ Begin Display Folder & Object Layout ################ Sub iGallery Set f = fso.GetFolder(fsDir) Set FileList = f.subFolders Dim emptyDir emptyDir = TRUE '''''''' dim arr,ctr ctr=0 arr=Split(f.name," ") If TopLevel Then Parent = "" %>
<%= GalleryName %>

<% Else Parent = fso.GetParentFolderName(fsDir) Parent = Replace(LCase(Parent),LCase(UploadPath),"") Parent = Replace(Parent,"\\","\") %>
<%For ctr=0 to UBound(arr) If arr(ctr)="mca" OR arr(ctr)="sa" OR arr(ctr)="odi" Then arr(ctr)=UCase(arr(ctr)) Else arr(ctr)=UCase(Left(arr(ctr),1)) & Right(arr(ctr),len(arr(ctr))-1) End if %><%=arr(ctr) & " "%><%next%>
<%= IG_uol %>
<% End If %> <% '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 %> <% Else %> <% End If fi = fi + 1 End If Next %>
<% DisplayGallery "DISPLAYFOLDERS",fn %>   <% DisplayGallery "DISPLAYFOLDERS",fn %>

<% 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 %> <% Case 2 %> <% Case 3 %> <% Case 4 %> <% Case 5 %> <% End Select End If %>
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>  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> 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> 
<% 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 %>
<%= IG_ded %>   
<% End If %> <% If Nailer AND Not TopLevel AND NOT RecordsCount = "0" Then %>
<%= IG_ri %> <% If Session(BaseDir&"-repair") = 1 Then %><% End If %>
<% End If %> <% If Not TopLevel AND NOT RecordsCount = "0" Then %>
<%= IG_si %> <% 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 %>
<%= IG_cnd1 %>:
<%= IG_rnd1 %>:
<% 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,"\\","\") %>
<% If Not TopLevel Then %>
"><%= IG_upttf1 %>
<% End If %>
<% If Not TopLevel Then %>

<%= IG_upttf2 %>
<% End If %>
<% End If %>

<% 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 %>