I have been trying for days to find a way to get the image width of .png files which reside on our server. I am trying to read the first 24 bytes of the file and parse out the width from bytes 17-20. I have found several routines on the web but have not been successful. Strangely enough, it seems I am getting the height from bytes 21-24 decoded from hex to decimal just fine. I have verified the file contents using a hex viewer and the file is good. Here is the main portion of the routine:
Function ReadPNG(fichero)
Dim fso, ts, s, HW, nbytes
HW = Array("0", "0")
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile(Server.MapPath("\forums\attachments/" & fichero), 1)
s = Right(ts.Read(24), 8)
HW(0) = HexToDec(HexAt(s,3) & HexAt(s,4))
HW(1) = HexToDec(HexAt(s,7) & HexAt(s,8))
ts.Close
ReadPNG = HW
End Function
Function HexAt(s, n)
HexAt = Hex(AscAt(s, n))
End Function
Function HexToDec(ByVal HexVal)
Dim i, num, part
num = 0
For I = 1 to Len(HexVal)
part = Mid(StrReverse(UCase(HexVal)), I, 1)
If IsNumeric(part) Then
num = num + (CInt(part) * 16 ^ (I - 1) )
Else
num = num + ( (Asc(part) - 55) * 16^(I - 1) )
End If
Next
HexToDec = num
End Function
As an example, my file has hex "00 00 01 80" in the width bytes (decimal 384)
and hex "00 00 01 32" in the heigth bytes (decimal 306)
I am getting the heigth 306 but thee width is returning "0011" (decimal 17).
I am totally stummped! I do not have to use this routine either.
Thanks,
Jim
Here is a post I saw awhile ago, looks like it could possibly simplify things a bit. I have not tested, so let me know your results.
<%
dim iWidth, iheight
sub ImgDimension(img)
dim myImg, fs
Set fs= CreateObject("Scripting.FileSystemObject")
if not fs.fileExists(img) then exit sub
set myImg = loadpicture(img)
iWidth = round(myImg.width / 26.4583)
iheight = round(myImg.height / 26.4583)
set myImg = nothing
end sub
ImgDimension(Server.MapPath("server image file"))
%>
See here for post: http://www.haneng.com/asp-forum/ASP---Get-Image-Size_12971.html
UPDATE: Seeing that this method will not work in 64bit. Here is a link to another alternative method: http://www.4guysfromrolla.com/webtech/050300-1.shtml
I use this simple function to return width, height and file size (eg. 640x480 - 200KBytes):
Function ImgDim(img)
Dim objFSO, objGF, objLP, imgWdt, imgHgt, imgSiz
img = Server.MapPath("/pictures/"& img) 'path to picture
Set objFSO= CreateObject("Scripting.FileSystemObject")
If objFSO.fileExists(img) Then
Set objGF = objFSO.GetFile(img)
imgSiz = objGF.Size
Set objGF = Nothing
Set objLP = loadpicture(img)
imgWdt = round(objLP.width / 26.4583)
imgHgt = round(objLP.height / 26.4583)
Set objLP = Nothing
Set fs = Nothing
ImgDim = imgWdt &"x"& imgHgt &" - "& imgSiz/1024 &"KBytes"
End If
End Function
works beautifully, hope it helps.
Here is a generic set of functions I found ages ago for getting information on an image. I'll put the way I've been using it at the end.
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::'
'::: :::'
'::: This routine will attempt to identify any filespec passed :::'
'::: as a graphic file (regardless of the extension). This will :::'
'::: work with BMP, GIF, JPG and PNG files. :::'
'::: :::'
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::'
'::: Based on ideas presented by David Crowell :::'
'::: (credit where due) :::'
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::'
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::'
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::'
'::: blah blah blah blah blah blah blah blah blah blah blah blah :::'
'::: blah blah blah blah blah blah blah blah blah blah blah blah :::'
'::: blah blah Copyright *c* MM, Mike Shaffer blah blah :::'
'::: blah blah ALL RIGHTS RESERVED WORLDWIDE blah blah :::'
'::: blah blah Permission is granted to use this code blah blah :::'
'::: blah blah in your projects, as long as this blah blah :::'
'::: blah blah copyright notice is included blah blah :::'
'::: blah blah blah blah blah blah blah blah blah blah blah blah :::'
'::: blah blah blah blah blah blah blah blah blah blah blah blah :::'
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::'
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::'
'::: :::'
'::: This function gets a specified number of bytes from any :::'
'::: file, starting at the offset (base 1) :::'
'::: :::'
'::: Passed: :::'
'::: flnm => Filespec of file to read :::'
'::: offset => Offset at which to start reading :::'
'::: bytes => How many bytes to read :::'
'::: :::'
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::'
function GetBytes(flnm, offset, bytes)
Dim objFSO
Dim objFTemp
Dim objTextStream
Dim lngSize
on error resume next
Set objFSO = CreateObject("Scripting.FileSystemObject")
' First, we get the filesize'
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 ' Get All!'
GetBytes = objTextStream.Read(lngSize) 'ReadAll'
else
GetBytes = objTextStream.Read(bytes)
end if
objTextStream.Close
set objTextStream = nothing
set objFSO = nothing
end function
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::'
'::: :::'
'::: Functions to convert two bytes to a numeric value (long) :::'
'::: (both little-endian and big-endian) :::'
'::: :::'
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::'
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
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::'
'::: :::'
'::: This function does most of the real work. It will attempt :::'
'::: to read any file, regardless of the extension, and will :::'
'::: identify if it is a graphical image. :::'
'::: :::'
'::: Passed: :::'
'::: flnm => Filespec of file to read :::'
'::: width => width of image :::'
'::: height => height of image :::'
'::: depth => color depth (in number of colors) :::'
'::: strImageType=> type of image (e.g. GIF, BMP, etc.) :::'
'::: :::'
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::'
function gfxSpex(flnm, width, height, depth, strImageType)
dim strPNG
dim strGIF
dim strBMP
dim strType
strType = ""
strImageType = "(unknown)"
gfxSpex = False
strPNG = chr(137) & chr(80) & chr(78)
strGIF = "GIF"
strBMP = chr(66) & chr(77)
strType = GetBytes(flnm, 0, 3)
if strType = strGIF then ' is GIF'
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 ' is BMP'
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 ' Is PNG'
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) ' Get all bytes from file'
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
I've been using it to generate a randomized XML file for an image library. The script only gets run when I finish uploading a new image to the library.
Here's the usage: (or at least how I used it)
'collect the image information into an array'
Dim blnGfxSpex, width, height, colors, strType
intCount = 0
For Each objFile In objFS.GetFolder(".\images").Files
If LCase(Right(objFile.Name, 4)) = ".jpg" and intCount <= intNumOfFiles Then
blnGfxSpex = gfxSpex((".\images\" & objFile.Name), width, height, colors, strType)
arrImages(intCount) = "<image>" & vbNewLine & _
"<filename>" & objFile.Name & "</filename>" & vbNewLine & _
"<caption></caption>" & vbNewLine & _
"<width>" & width & "</width>" & vbNewLine & _
"<height>" & height & "</height>" & vbNewLine & _
"</image>" & vbNewLine
intCount = intCount + 1
End If
Next
As you can see, I'm initializing the variables for width, height, etc. and the function sets them as appropriate. I know it's not kosher to use global variables like that, but it works.
Performance isn't as bad as you would think. In this particular case I am filtering the image library to just JPGs, but that is due to a limitation in the image library the XML is for, not due to a limitation in the functions.
