Does anyone have a asp/vbscript way of getting the height and width of a picture of any kind for server side processing???
Printable View
Does anyone have a asp/vbscript way of getting the height and width of a picture of any kind for server side processing???
i have used code based on this for a while.
http://www.4guysfromrolla.com/webtec...imgsz.asp.html
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
%>
i assume that i would use it like this
[Highlight=VB]
<!--#include virtual ="grfxfunctions.asp" -->
<%
dim filename, hh, ww, dd
filename = "/somepic.jpg"
gfxSpex filename, ww, hh, dd
response.write("width: " & ww & "<BR>")
response.write("height: " & hh & "<BR>")
response.write("depth: " & dd & "<BR>")
%>
yep, except you need the full physical path of the image.
filename = Server.Mappath("./somepic.jpg")
Code:<!--#INCLUDE FILE="grfxfunctions.asp"-->
<%
dim filename, hh, ww, dd
filename = Server.MapPath("./somepic.jpg")
gfxSpex filename, ww, hh, dd
response.write("width: " & ww & "<BR>")
response.write("height: " & hh & "<BR>")
response.write("depth: " & dd & "<BR>")
%>
ty rory for the help...now i can finally make 3 - 4 site i have half finished
cool, good luck :wave:
ty for then help...i posted this question about a year ago with no resolution.
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 t**** = t**** + 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 & "<td style=""pictable"" witdh=""" & maxw & """ align=""center"" valign=""middle""><a style=""pictable"" href=""" & fdir & "/" & f.name & """><img style=""pictable"" src=""" & fdir & "/" & f.name & """ width=""" & tempw & """ height=""" & temph & """></a></td>" t**** = t**** + 1 **** = **** + 1 if **** = 5 then pictable = pictable & "</tr><tr>" **** = 0 end if end if else end if Next if (t****) = 0 then pictable = pictable & "No Images In Specified Directory" else pictable = pictable & "</td></tr><tr><td>" **** = t**** - skip - 25 if skip => 25 then pictable = pictable & "<form style=""pictable"" action=""" & page & """ method=""get""><input name=""skip"" type=""hidden"" value=""" & skip-25 & """ /><input style=""pictable"" value=""< Back 25"" type=""submit"" /></form>" else pictable = pictable & " " end if pictable = pictable & "</td><td style=""pictable"" colspan=3> </td><td>" if **** > 0 then if **** < 25 then pictable = pictable & "<form style=""pictable"" action=""" & page & """ method=""get""><input name=""skip"" type=""hidden"" value=""" & skip+25 & """ /><input style=""pictable"" value=""Next " & **** & ">"" type=""submit"" /></form>" else pictable = pictable & "<form style=""pictable"" action=""" & page & """ method=""get""><input name=""skip"" type=""hidden"" value=""" & skip+25 & """ /><input style=""pictable"" value=""Next 25 >"" type=""submit"" /></form>" end if else pictable = pictable & " " end if pictable = pictable & "</td></tr></table>" 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 %>