Rundgang
<%If Request("cat") = "" Then%>
Wählen Sie Ihre gewünschte Bild-Kategorie aus:
<%
' Create our FSO
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
' Get a handle on our folder
Set objFolder = objFSO.GetFolder(Server.MapPath("/bilder"))
Set Jpeg = Server.CreateObject("Persits.Jpeg")
For Each objItem In objFolder.SubFolders
' Deal with the stupid VTI's that keep giving our visitors 404's
If InStr(1, objItem, "_hidden_", 1) = 0 and InStr(1, objItem, "includes", 1) = 0 Then
Kategorie = Mid(objItem.Name,InStr(objItem.Name," "))
Kategorie2 = objItem.Name
Zaehler = False
' erste Datei als Thumbnail öffnen
Set objFolder2 = objFSO.GetFolder(Server.MapPath("/bilder/" & objItem.Name))
For Each objItem2 In objFolder2.Files
If Zaehler = False Then
CatPic = Server.MapPath("Bilder\" & Kategorie2 & "\" & objItem2.Name)
Zaehler = True
End If
Next 'objItem2
%>
<%
End If
Next 'objItem
%>
<%Else%>
Klicken Sie auf die Bilder um sie zu vergrössern.
<%
'====================================================================
'Copyright (C) 2004 VirtualFlair.com
'====================================================================
'The script is licensed as follows:
'You may copy, display and modify the script as long as all copyright
'notices and comments by the original author remains intact.
'You may distribute the script in the original unaltered version only
'for non-commercial use and without profiting by it.
'If you wish to distribute an altered version of the script for
'non-commercial or commercial use you are obligated to contact the
'original author of the script and get his/hers consent.
'====================================================================
'==========settings==========
Dim pageTitle, imageDirectory, thumbnailHeight, thumbnailWidth, itemsPerPage, itemsPerRow, allowedImageTypes
pageTitle = ""
imageDirectory = "bilder\" & Request("cat")
thumbnailHeight = "75"
thumbnailWidth = "75"
itemsPerPage = 24
itemsPerRow = 6
allowedImageTypes = "gif, jpg, png"
'Response.Write(Server.MapPath(imageDirectory))
Public Sub printGallery()
Call initiateGallery()
Call printImages()
Call printPaging()
End Sub
Dim intTotalItems, intCurrentPage, intStartItem, arrItems
Sub initiateGallery()
'==========paging==========
intCurrentPage = Request.QueryString("page")
If intCurrentPage = "" Or Int(intCurrentPage) = 0 Then
intCurrentPage = 1
End If
intStartItem = (((intCurrentPage - 1) * itemsPerPage) + 1)
If Int(intStartItem) = 0 Then
intStartItem = 1
End If
'==========get images==========
'==>
Dim objFso, objFolderFiles
Set objFso = Server.CreateObject("Scripting.FileSystemObject")
Set objFolderFiles = objFso.GetFolder(Server.MapPath(imageDirectory))
allowedImageTypes = Split(allowedImageTypes, ",")
Dim objItem, i, bolFileExtensionAllowed
For Each objItem In objFolderFiles.files
bolFileExtensionAllowed = 0
'==========check if file extension is allowed==========
For i = 0 To UBound(allowedImageTypes)
If LCase(objFso.GetExtensionName(objItem)) = LCase(Trim(allowedImageTypes(i))) Then
bolFileExtensionAllowed = 1
Exit For
End If
Next
'==========add image to "arrItems"==========
If bolFileExtensionAllowed = 1 Then
intTotalItems = (intTotalItems + 1)
If Int(intStartItem) <= Int(intTotalItems) And Int(intTotalItems) < Int(intStartItem + itemsPerPage) Then
If arrItems = "" Then
arrItems = arrItems & objItem.Name
Else
arrItems = arrItems & "," & objItem.Name
End If
End If
End If
Next
Set objFolderFiles = Nothing
Set objFso = Nothing
'<==
End Sub
Sub printImages()
arrItems = split(arrItems, ",")
Response.Write (" ") & vbNewline
Response.Expires = 0
' create instance of AspJpeg
Set Jpeg = Server.CreateObject("Persits.Jpeg")
'Jpeg.PreserveAspectRatio = True
Dim i, itemPrints
For i = 0 To UBound(arrItems)
itemPrints = itemPrints + 1
If Int(itemPrints) = 1 Then
Response.Write ("") & vbNewline
End If
Path = Server.MapPath(imageDirectory & "/" & arrItems(i))
' Open source file
'Jpeg.Open Path
' Set new height and width
'Response.Write(thumbnailWidth)
'Jpeg.Width = thumbnailWidth
'Jpeg.Height = Jpeg.OriginalHeight * Jpeg.Width / Jpeg.OriginalWidth
' Perform resizing and
' send resultant image to client browser
'Jpeg.SendBinary
Response.Write ("") &_
"![]() " &_
" | " & vbNewline
Jpeg.Close
If Int(itemPrints) = Int(itemsPerRow) Or i = UBound(arrItems) Then
itemPrints = 0
Response.Write (" ") & vbNewline
End If
Next
Response.Write (" ") & vbNewline
End Sub
Sub printPaging()
Dim intTotalPages
intTotalItems = intTotalItems
intTotalPages = (intTotalItems / itemsPerPage)
If Int(intTotalPages) < intTotalPages Then
intTotalPages = Int(intTotalPages + 1)
End If
Dim strPageName
strPageName = Request.ServerVariables("script_name")
'==========print paging==========
Response.Write ("")
If 1 < intTotalPages Then
Response.Write (" Seite: ")
Dim i
For i = 1 To intTotalPages
If Int(intCurrentPage) =Int(i) Then
Response.Write (" ( "& i &")")
Else
Response.Write (" " & i & "")
End If
If Not i = intTotalPages Then
Response.Write (", ")
End If
Next
End If
Response.Write (" Zurück
<% Call printGallery() %>
<%End if%>
|
