here is my slightly modded version. (You will need to add your own error checking though)
Add the original authors credit in somewhere also,
i just cleaned it up for this example.
Code:
<%@ Language=VBScript %>
<%
Option Explicit
Response.Buffer = True
Dim imgWidth, imgHeight, imgColors, imgFile
imgFile = Server.Mappath(Request("img"))
If gfxSpex(imgFile, imgWidth, imgHeight, imgColors) = True Then
Response.Write imgFile & " (" & imgWidth & " x " & imgHeight & ")"
Else
Response.Write imgFile & " (Unknown Size)"
End If
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::: :::
'::: ****** FILE FUNCTIONS ****** :::
'::: :::
'::: flnm => Filespec of file to read :::
'::: width => width of image :::
'::: height => height of image :::
'::: depth => color depth (in number of colors) :::
'::: :::
'::: Copyright *c* MM, Mike Shaffer :::
'::: Based on ideas presented by David Crowell :::
'::: ALL RIGHTS RESERVED WORLDWIDE :::
'::: :::
'::: Modified from Original :::
'::: :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
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
%>
For all of those who are like me and still need help, I have created a simple function to automatically put the graphics into a gallery style 5 by 5 table with next and back buttons. It also has the CCS class of pictable in all tags for 100% customization.
You use it like a function. the syntax for the function is:
VB Code:
<!--#INCLUDE FILE="grfx.asp"-->
<%=pictable(MaxHeight, MaxWidth, FileDirectory%>
Here is the code as well as the file to attach.
VB Code:
<%
' 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
**** = 0
t**** = 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 t**** = 0 then pictable = pictable & "<table style=""pictable""><tr>"
if (skip > 0 and skip > t****) or t**** - skip => 25 then
[RESOLVED] Picture Height/Width
Reply With Quote
