<% @LANGUAGE="VBSCRIPT" %> <% Option Explicit %> <% Server.ScriptTimeout = 3600 %> <% dim dir dim from dim title dim pictsize dim pictdir dim accesslevel dir = Request("dir") from = Request("from") title = Request("title") title = replace(title, "_", " ") dim privileged privileged = session("privileged") = 1 if dir <> "" then pictsize = Request("pictsize") %> <% dim originalsDir dim originalsURL dim thumbnailsDir dim thumbnailsURL dim imagesSmallDir dim imagesSmallURL dim imagesBigDir dim imagesBigURL dim rootDir dim image Set image = Server.CreateObject("AspImage.Image") originalsURL = "gallery/" & dir & "/originals/" thumbnailsURL = "gallery/" & dir & "/thumbnails/" imagesSmallURL = "gallery/" & dir & "/imagesSmall/" imagesBigURL = "gallery/" & dir & "/imagesBig/" rootDir = Request.ServerVariables("APPL_PHYSICAL_PATH") originalsDir = rootDir & "gallery\" & dir & "\originals\" thumbnailsDir = rootDir & "gallery\" & dir & "\thumbnails\" imagesSmallDir = rootDir & "gallery\" & dir & "\imagesSmall\" imagesBigDir = rootDir & "gallery\" & dir & "\imagesBig\" if pictsize = "small" then pictdir = imagesSmallURL else pictdir = imagesBigURL end if Dim objFSO , objFileItem , objFolder , objFolderFiles set objFSO = CreateObject("Scripting.FileSystemObject") set objFolder = objFSO.GetFolder(originalsDir) set objFolderFiles = objFolder.Files dim dsn dim objConn dim captionObj dim displayIt dsn="DBQ=" & Server.Mappath("md.mdb") & ";Driver={Microsoft Access Driver (*.mdb)};" Set objConn = Server.CreateObject("ADODB.Connection") objConn.Open dsn Set captionObj = Server.CreateObject("ADODB.Recordset") %> <% if true then %> <%=title%>
<%if privileged = true then%> Admin Mode Add New Picture
<%end if %> <% 'i = 0 For Each objFileItem In objFolderFiles if not objFSO.FileExists(thumbnailsDir & objFileItem.Name) then CreateImages(objFileItem.Name) end if Response.Write "" %> <% Response.Write "" Next set captionObj = nothing objConn.close set objConn = nothing on error goto 0 %>

<% if left(objFileItem.Name, 1) = "_" then 'if session("access") > 0 or privileged then accesslevel = "" & session("access") & "" 'response.write(accesslevel & "-" & mid(objFileItem.Name,2,1) & " ") if (accesslevel = mid(objFileItem.Name,2,1)) or privileged then displayIt = true else displayIt = false end if else displayIt = true end if %> <% if displayIt = true then %> <% end if %> <% if privileged = true then %><%=objFileItem.Name%> Delete | Rename | Caption <% else %><% if displayIt = true then captionObj.Open "select * from caption where filename = '" & objFileItem.Name & "'", objConn if not captionObj.EOF then%> <%=captionObj("shortcaption")%> <%end if captionObj.Close end if %> <% end if %>

<% end if ' if false%> <% end if set image=nothing set objFSO = nothing set objFolder = nothing set objFolderFiles = nothing sub CreateImages(filename) dim theX dim theY dim newX dim newY dim frameFilePath Response.Write("Adding: " & filename & "
") Image.BackgroundColor = vbBlack Image.ClearImage Image.GetImageFileSize originalsDir & filename, theX, theY newX = 160 newY = fix((newX / theX)*theY) if not objFSO.FolderExists(thumbnailsDir) then objFSO.CreateFolder(thumbnailsDir) end if Image.LoadImage(originalsDir & filename) Image.ResizeR newX, newY Image.FileName = thumbnailsDir & filename Image.JPEGQuality = 85 Image.SaveImage Image.Resize newX+12, newY+12 drawFrame newX, newY Image.AddImage thumbnailsDir & filename, 6, 6 Image.FileName = thumbnailsDir & filename Image.SaveImage if theX > theY then newX = 400 newY = fix((newX / theX)*theY) else newY = 400 newX = fix((newY / theY)*theX) end if if not objFSO.FolderExists(imagesSmallDir) then objFSO.CreateFolder(imagesSmallDir) end if Image.LoadImage(originalsDir & filename) Image.ResizeR newX, newY Image.FileName = imagesSmallDir & filename Image.SaveImage Image.Resize newX+12, newY+12 drawFrame newX, newY Image.AddImage imagesSmallDir & filename, 6, 6 Image.FileName = imagesSmallDir & filename Image.SaveImage if theX > theY then newX = 550 newY = fix((newX / theX)*theY) else newY = 550 newX = fix((newY / theY)*theX) end if if not objFSO.FolderExists(imagesBigDir) then objFSO.CreateFolder(imagesBigDir) end if Image.LoadImage(originalsDir & filename) Image.ResizeR newX, newY Image.FileName = imagesBigDir & filename Image.SaveImage Image.Resize newX+12, newY+12 drawFrame newX, newY Image.AddImage imagesBigDir & filename, 6, 6 Image.FileName = imagesBigDir & filename Image.SaveImage end sub sub drawframe (newX, newY) Image.PenColor = RGB(&h33, &h00, &hff) ' Outside top Image.X = 0 Image.Y = 0 Image.LineTo newX+12, 0 Image.X = 0 Image.Y = 1 Image.LineTo newX+11, 1 Image.X = 0 Image.Y = 2 Image.LineTo newX+10, 2 ' Outside left Image.X = 0 Image.Y = 0 Image.LineTo 0, newY+12 Image.X = 1 Image.Y = 0 Image.LineTo 1, newY+11 Image.X = 2 Image.Y = 0 Image.LineTo 2, newY+10 ' Inside bottom Image.X = 3 Image.Y = newY+8 Image.LineTo newX+9, newY+8 Image.X = 4 Image.Y = newY+7 Image.LineTo newX+8, newY+7 Image.X = 5 Image.Y = newY+6 Image.LineTo newX+7, newY+6 ' Inner left Image.X = newX+8 Image.Y = 3 Image.LineTo newX+8, newY+9 Image.X = newX+7 Image.Y = 4 Image.LineTo newX+7, newY+8 Image.X = newX+6 Image.Y = 5 Image.LineTo newX+6, newY+7 Image.PenColor = RGB(&h00, &h00, &h00) ' inside top Image.X = 3 Image.Y = 3 Image.LineTo newX+9, 3 Image.X = 4 Image.Y = 4 Image.LineTo newX+8, 4 Image.X = 5 Image.Y = 5 Image.LineTo newX+7, 5 ' inside left Image.X = 3 Image.Y = 3 Image.LineTo 3, newY+8 Image.X = 4 Image.Y = 4 Image.LineTo 4, newY+7 Image.X = 5 Image.Y = 5 Image.LineTo 5, newY+6 'Outside right Image.X = newX+11 Image.Y = 1 Image.LineTo newX+11, newY+12 Image.X = newX+10 Image.Y = 2 Image.LineTo newX+10, newY+12 Image.X = newX+9 Image.Y = 3 Image.LineTo newX+9, newY+12 ' Outside bottom Image.X = 1 Image.Y = newY+11 Image.LineTo newX+9, newY+11 Image.X = 2 Image.Y = newY+10 Image.LineTo newX+9, newY+10 Image.X = 3 Image.Y = newY+9 Image.LineTo newX+9, newY+9 end sub %>