<% ' pictable Syntax ' ' maxh => Filespec of file to read ' maxw => width of image ' fdir => height of image ' ' style sheet class = "pictable" ' Has a CCS in every tag for maximum customization. ' ' description: ' returns a table containing resized images. will work with ' JPG, PNG, BMP, and GIF. Has Error Handling. ' ' Example: ' <%=pictable(150,150,".")%> function pictable(maxh, maxw, fdir) on error resume next if len(maxh) < 1 then maxh = 150 elseif maxh =< 0 then maxh = 150 end if if len(maxw) < 1 then maxw = 150 elseif maxw =< 0 then maxw = 150 end if if len(fdir) < 1 then fdir = "." Page = Request.ServerVariables("URL") Page = mid(Page,InStrRev(Page,"/") + 1) skip = int(request.querystring("skip")) if len(skip) = 0 then skip = 0 Set fso = Server.CreateObject("Scripting.FileSystemObject") Set fldr = fso.GetFolder(Server.MapPath(fdir)) if err = 0 then cunt = 0 tcunt = 0 For Each f in fldr.Files if ext(ucase(f.name)) = "JPG" or ext(ucase(f.name)) = "PNG" or ext(ucase(f.name)) = "GIF" or ext(ucase(f.name)) = "BMP" then if tcunt = 0 then pictable = pictable & "" if (skip > 0 and skip > tcunt) or tcunt - skip => 25 then tcunt = tcunt + 1 else filename = Server.MapPath(fdir & "/" & f.name) gfxSpex filename, ww, hh, dd if ww > maxw and hh > maxh then if ww > hh then temp = ww / maxw tempw = maxw temph = hh / temp else temp = hh / maxh temph = maxh tempw = ww / temp end if elseif ww =< maxw and hh > maxh then temp = hh / maxh temph = naxh tempw = ww / temp elseif ww > maxw and hh =< maxh then temp = ww / maxw tempw = maxw temph = hh / temp elseif ww =< maxw and hh =< maxh then tempw = ww temph = hh end if pictable = pictable & "" tcunt = tcunt + 1 cunt = cunt + 1 if cunt = 5 then pictable = pictable & "" cunt = 0 end if end if else end if Next if (tcunt) = 0 then pictable = pictable & "No Images In Specified Directory" else pictable = pictable & "

" cunt = tcunt - skip - 25 if skip => 25 then pictable = pictable & " " else pictable = pictable & " " end if pictable = pictable & "				" if cunt > 0 then if cunt < 25 then pictable = pictable & " " else pictable = pictable & " " end if else pictable = pictable & " " end if pictable = pictable & "

" end if elseif err = 76 then pictable = pictable & "Directory Doesn't Exist Or Is In Wrong Syntax" elseif err = -2147467259 then pictable = pictable & ".. Directory Cannot Be Used" elseif err = 13 then pictable = pictable & "Please enter a MaxHeight and/or MaxWidth" else pictable = pictable & "Unknown Error #" & err end if end function ' gfxSpex Syntax ' ' flnm => Filespec of file to read ' width => width of image ' height => height of image ' depth => color depth (in number of colors) ' Function gfxSpex(flnm, width, height, depth) dim strType dim strImageType dim strTarget dim strPNG dim strGIF dim strJPG dim strBMP dim ExitLoop dim strBuff dim flgFound dim lngMarkerSize dim lngSize dim lngPos strType = "" gfxSpex = False strPNG = chr(137) & chr(80) & chr(78) strGIF = "GIF" strJPG = "JPG" strBMP = chr(66) & chr(77) strType = GetBytes(flnm, 0, 3) if strType = strGIF then strImageType = "GIF" Width = lngConvert(GetBytes(flnm, 7, 2)) Height = lngConvert(GetBytes(flnm, 9, 2)) Depth = 2 ^ ((asc(GetBytes(flnm, 11, 1)) and 7) + 1) gfxSpex = True elseif left(strType, 2) = strBMP then strImageType = "BMP" Width = lngConvert(GetBytes(flnm, 19, 2)) Height = lngConvert(GetBytes(flnm, 23, 2)) Depth = 2 ^ (asc(GetBytes(flnm, 29, 1))) gfxSpex = True elseif strType = strPNG then strImageType = "PNG" Width = lngConvert2(GetBytes(flnm, 19, 2)) Height = lngConvert2(GetBytes(flnm, 23, 2)) Depth = getBytes(flnm, 25, 2) select case asc(right(Depth,1)) case 0 Depth = 2 ^ (asc(left(Depth, 1))) gfxSpex = True case 2 Depth = 2 ^ (asc(left(Depth, 1)) * 3) gfxSpex = True case 3 Depth = 2 ^ (asc(left(Depth, 1))) '8 gfxSpex = True case 4 Depth = 2 ^ (asc(left(Depth, 1)) * 2) gfxSpex = True case 6 Depth = 2 ^ (asc(left(Depth, 1)) * 4) gfxSpex = True case else Depth = -1 end select else strBuff = GetBytes(flnm, 0, -1) lngSize = len(strBuff) flgFound = 0 strTarget = chr(255) & chr(216) & chr(255) flgFound = instr(strBuff, strTarget) if flgFound = 0 then exit Function end if strImageType = "JPG" lngPos = flgFound + 2 ExitLoop = false do while ExitLoop = False and lngPos < lngSize do while asc(mid(strBuff, lngPos, 1)) = 255 and lngPos < lngSize lngPos = lngPos + 1 loop if asc(mid(strBuff, lngPos, 1)) < 192 or asc(mid(strBuff, lngPos, 1)) > 195 then lngMarkerSize = lngConvert2(mid(strBuff, lngPos + 1, 2)) lngPos = lngPos + lngMarkerSize + 1 else ExitLoop = True end if loop if ExitLoop = False then Width = -1 Height = -1 Depth = -1 else Height = lngConvert2(mid(strBuff, lngPos + 4, 2)) Width = lngConvert2(mid(strBuff, lngPos + 6, 2)) Depth = 2 ^ (asc(mid(strBuff, lngPos + 8, 1)) * 8) gfxSpex = True end if end if End Function Function GetBytes(flnm, offset, bytes) Dim objFSO Dim objFTemp Dim objTextStream Dim lngSize Dim fsoForReading on error resume next Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFTemp = objFSO.GetFile(flnm) lngSize = objFTemp.Size set objFTemp = nothing fsoForReading = 1 Set objTextStream = objFSO.OpenTextFile(flnm, fsoForReading) if offset > 0 then strBuff = objTextStream.Read(offset - 1) end if if bytes = -1 then GetBytes = objTextStream.Read(lngSize) else GetBytes = objTextStream.Read(bytes) end if objTextStream.Close set objTextStream = nothing set objFSO = nothing End Function Function lngConvert(strTemp) lngConvert = clng(asc(left(strTemp, 1)) + ((asc(right(strTemp, 1)) * 256))) End Function Function lngConvert2(strTemp) lngConvert2 = clng(asc(right(strTemp, 1)) + ((asc(left(strTemp, 1)) * 256))) End Function Function ext(strTemp) ext = mid(strtemp, len(strtemp) - 2, 3) End Function %>