<% ' This is BBC Webgallery V4.0. The script is freeware for private usage. ' For COMMERCIAL USE, please contact me on brian@brinch.it. Any commercial use without contacting me will be billed ' without any notice!! ' ' To use this script, it's recommended to have the AspImage component installed on the server. ' But no matter what, the script will work, because it will check if AspImage is installed or ' not. If not then thumbnails are just created, using width/height on the IMG tag, but the performance on this is poor. ' ' To use this script on your own server, you have to change a few statements. All statements ' that have to be changed, is marked in the section below these comments ' ' I can not give any support on this script (you know, it's freeware, bla. bla.) But however ' you can try to ask in any ASP forums. The script is pretty easy and self documentated. ' ' Good luck with the script and if you need to see any examples where the script is used, ' take a look at http://www.brinch.it/webgalleryv4/webgalleryv4.asp ' The script is by default shipped with the following files: webgalleryv4.asp, webgalleryv4.css, crttmb.asp ' ' ' ***** New things in this version ***** ' ' - Only 4 lines of constants to be changed to make it work. ' - Few errors from other version are corrected ' - .CSS file to make it easy to individualize the design ' - Easy control of subfolders ' - All texts have been put into constants to make it easy to change ' - Source is cleaned, more comments and better structure ' - Script is now validating strict HTML 4 ' - Script is tested in IE 6.0, FireFox and Opera ' ' ' ' ' ' ****Updates**** ' 29-03-2006 Txt12 variable added. ' 29-03-2006 Force a 800x600 in the popup window ' ********************************************************************* ' * Below is all the constants that you can change to individualize ' * Your own album ' ********************************************************************* ImageDir = "/bilder/" ' ImageDir must be entered with / and NOT \ !!!!!! AlbumTitle = "HIMCC Bildarkiv" ' Title of the album Columns = 4 ' How many Columns with pictures? Rows = 4 ' How many Rows with pictures? TmbSize = 80 ' This is the size of the generated thumbnail ' ********************************************************************* ' * Text constants for all texts in the gallery ' ********************************************************************* Txt1 = "[Föreg. Album]" Txt2 = "[Nästa Bild]" Txt3 = "[Föreg. Bild]" Txt4 = "Antal bilder i Album" Txt5 = "Detta är bild nr" Txt6 = "av" Txt7 = "Stäng Fönster" Txt8 = "[Nästa Sida]" Txt9 = "[Föreg. Sida]" Txt10 = "Detta är Sida" Txt11 = "Återgå" Txt12 = "Detta Album är tomt" ' ********************************************************************* ' * Initiate all the vars that can be calculated/constants ' ********************************************************************* ' Replace all / with \ to use with FSO ImageDirBack = Replace(ImageDir, "/", "\", 1, -1, 1) strScriptName = Request.Servervariables("script_name") OrgDir = ImageDirBack PicturesOnPage = Columns * Rows PageNumber = request.Querystring("Page") If isNumeric(PageNumber) = False Or PageNumber < 1 Then PageNumber = 1 End If PicID = request.Querystring("PicID") Album = request.Querystring("Album") If Album <> "" THEN ImageDir = ImageDir & Album & "/" End If FirstPicture = ((PageNumber-1) * PicturesOnPage) LastPicture = (FirstPicture + PicturesOnPage) - 1 ImageDirJS = Replace(ImageDir, "\", "/", 1, -1, 1) ' ****************************************************************** ' This function is checking if AspImage is installed or not. ' ****************************************************************** Function IsComponentInstalled(ProgId) Dim tmpObject On Error Resume Next Set tmpObject = Server.CreateObject(ProgId) If Err.Number = 0 Then IsComponentInstalled = True Else IsComponentInstalled = False End If Set tmpObject = Nothing End Function Response.Write "" Response.Write "" Response.Write "" Response.Write "" & AlbumTitle & "" Response.Write "Åter till huvudsidan" Response.Write "" Response.Write "" Response.Write "" %> <% Response.Write "" Response.Write "" Response.Write "

" & AlbumTitle & "

" ' ********************************************************************* ' * This part will find all existing subfolders and if any exists ' * then show them all as a link. ' ********************************************************************* NumberOfFolders = 0 DIM FolderArray directpath = lcase(server.mappath("\") & ImageDir) orgdirect = lcase(server.mappath("\") & OrgDir) Set fso = CreateObject("Scripting.FileSystemObject") Set folder = fso.GetFolder(directpath) IF Album <> "" THEN ParentFolder = lcase(folder.ParentFolder & "\") IF ParentFolder = orgdirect THEN ParentAlbum = "" ELSE Pos = CINT(LEN(ParentFolder)-LEN(orgdirect))-1 ParentAlbum = MID(ParentFolder, CINT(LEN(ParentFolder)-Pos), Pos) END IF END IF Set subFolders = folder.SubFolders For Each folderObject in SubFolders NumberOfFolders = NumberOfFolders + 1 FolderList = FolderList & folderObject.Name & "," Next FolderArray = Split(FolderList,",") Set subFolders = Nothing Set folder = Nothing Set fso = Nothing Response.Write "
" IF Album <> "" THEN ' ***************************************************************************************************************** ' If user is watching a picture, we give a link back to the album and page where the picture was located ' ***************************************************************************************************************** IF PicID <> "" THEN ToPage = (CINT(PicID)+1)/PicturesOnPage IF ToPage > int(ToPage) THEN ToPage= int(ToPage) + 1 END IF IF ToPage = 0 THEN ToPage = 1 END IF Response.Write ""&Txt11&" "&Album&"
" ELSE ' ***************************************************************************************************************** ' If we are deeper than the root album, we give a link to the parent album ' ***************************************************************************************************************** IF ParentAlbum <> "" THEN Response.Write ""&Txt1&"
" ELSE Response.Write ""&Txt1&"
" END IF END IF END IF IF NumberOfFolders > 0 THEN FOR FCount=0 TO NumberOfFolders-1 ' ***************************************************************************************************************** 'We have to check if current directory is a subfolder. Then Add the actual subfolder to the path ' ***************************************************************************************************************** IF Album <> "" THEN AlbumPath = Album & "/" & FolderArray(FCount) ELSE AlbumPath = FolderArray(FCount) END IF Response.Write ""&FolderArray(FCount)&"
" Next END IF Response.Write "
" ' ************************************************************************* ' * This part will find all pictures in the folder and show them as links ' ************************************************************************* DIM PictureArray Set objFS = CreateObject("Scripting.FileSystemObject") Set objFolder = objFS.GetFolder(Server.MapPath(ImageDir)) Set objFiles = objFolder.Files TotalPics = objFiles.Count For Each Image In objFiles NumberOfPics = NumberOfPics + 1 PictureList = PictureList & Image.Name & "," Next PictureArray = Split(PictureList,",") Set objFS = Nothing Set objFolder = Nothing Set objFiles = Nothing ' ***************************************************************************************************************** ' * Now we calculate how many pages we have in the current album (directory) ' ***************************************************************************************************************** NumberOfPages = -Int(-(NumberOfPics/PicturesOnPage)) Response.Write "
" IF NumberOfPics > 0 THEN Response.Write "" Response.Write "" Response.Write "" IF PicID = "" THEN Response.Write "" ELSE Response.Write "" PageNumber = (CINT(PicID)+1)/PicturesOnPage IF PageNumber > int(PageNumber) THEN PageNumber = int(PageNumber) + 1 END IF IF PageNumber = 0 THEN PageNumber = 1 END IF END IF Response.Write "" Response.Write "
"&Txt4&" " & NumberOfPics & "
"&Txt10&" "&PageNumber&" "&Txt6&" " & NumberOfPages&""&Txt5&" "&PicID+1&" "&Txt6&" " & NumberOfPics&"
" Response.Write "" Response.Write "" ' ***************************************************************************************************************** ' * This check is if a Picture-ID was sent as a parameter. Then we will show that picture instead of thumbs ' ***************************************************************************************************************** IF PicID <> "" THEN IF IsComponentInstalled("AspImage.Image") Then Set Image = Server.CreateObject("AspImage.Image") Image.LoadImage directpath & PictureArray(PicID) thewidth= Image.MaxX theheight = Image.MaxY Set objImg = Nothing ELSE thewidth = 800 theheight = 600 END IF IF CINT(PicID) = 0 THEN PrevPic = CINT(NumberOfPics-1) ELSE PrevPic = CINT(PicID-1) END IF IF CINT(PicID) = CINT(NumberOfPics-1) THEN NextPic = 0 ELSE NextPic = CINT(PicID+1) END IF ' ***************************************************************************************************************** ' Build the string that will show Prev. And Next Picture. We have to difference if it's a subfolder or not :-( ' ***************************************************************************************************************** IF Album <> "" THEN PrevString = "" ELSE PrevString = "" END IF Response.Write PrevString Scrstring = "javascript:openwindow('"&PictureArray(PicID)&"',"&thewidth&","&theheight&")" Response.write "" ELSE ' ***************************************************************************************************************** ' * If the calculated last picture number is greater than the number of pictures, then only show until the last one ' ***************************************************************************************************************** IF LastPicture > NumberOfPics THEN LastPicture = NumberOfPics - 1 END IF CountTDS = 1 FOR PCount=FirstPicture TO LastPicture ' ***************************************************************************************************************** ' Build the string that will show the thumbnails. We have to difference if it's a subfolder or not :-( ' ***************************************************************************************************************** If IsComponentInstalled("AspImage.Image") Then IF Album <> "" THEN PicString = ""&vbCrLf ELSE PicString = ""&vbCrLf END IF ELSE IF Album <> "" THEN PicString = ""&vbCrLf ELSE PicString = ""&vbCrLf END IF END IF Response.Write PicString CountTDS = CountTDS + 1 IF CountTDS > Columns THEN CountTDS = 1 Response.Write ""&vbCrLf&"" END IF Next Response.Write "" END IF Response.Write "" Response.Write "
"&Txt3&" "&Txt2&"
"&Txt3&" "&Txt2&"
" Response.Write "
" ELSE Response.Write Txt12 END IF ' ***************************************************************************************************************** ' * Then we setup what pagenumbers we want to show if we have more that 9 pages ' ***************************************************************************************************************** IF NumberOfPages > 1 THEN IF NumberOfPages <= 9 THEN FirstPage = 1 LastPage = NumberOfPages END IF IF NumberOfPages > 9 THEN FirstPage = INT(PageNumber-4) IF FirstPage < 1 THEN FirstPage = 1 END IF LastPage = INT(FirstPage+8) IF LastPage > NumberOfPages THEN LastPage = NumberOfPages FirstPage = INT(NumberOfPages-8) END IF END IF ' ***************************************************************************************************************** ' * Setup the bottom-box with the pages. But only if we have more tham 1 page ' ***************************************************************************************************************** Response.Write "
" ' ***************************************************************************************************************** ' If current page is greater than 1, then we show the prev. button. ' ***************************************************************************************************************** IF CINT(PageNumber) > 1 THEN ' ***************************************************************************************************************** ' And again we have to check if the current folder is a subfolder.... ' ***************************************************************************************************************** IF Album <> "" THEN Response.Write ""&Txt9&"" ELSE Response.Write ""&Txt9&"" END IF END IF FOR PageCounter = FirstPage TO LastPage ' ***************************************************************************************************************** ' And one more time we will check if the current folder is a subfolder.... ' ***************************************************************************************************************** IF Album <> "" THEN Response.Write ""&PageCounter&"  " ELSE Response.Write ""&PageCounter&"  " END IF Next ' ***************************************************************************************************************** ' * If we have more than 1 page and current page is not the last page, then show the next button ' ***************************************************************************************************************** IF CINT(PageNumber) < CINT(NumberOfPages) THEN ' ***************************************************************************************************************** ' And guess what... We check the subfolder again! ' ***************************************************************************************************************** IF Album <> "" THEN Response.Write ""&Txt8&"" ELSE Response.Write ""&Txt8&"" END IF END IF Response.Write "
" END IF %>