Login
Important alert: (current site time 7/15/2013 11:36:54 PM EDT)
 

VB icon

cAspImage

 Email
Submitted on: 6/9/2005 7:57:20 AM
By: Terje Hauger  
Level: Advanced
User Rating: By 5 Users
Compatibility: ASP (Active Server Pages)
Views: 8999
 
     cAspImage is a vbscript class that lets you read various properties from image files, including width, height and color depth. This cannot be done directly with ASP/vbscript because this type of information has to be parsed out from the image file itself. Supported file formats are PNG, GIF, BMP and JPG.
 
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
 
Terms of Agreement:   
By using this code, you agree to the following terms...   
  1. You may use this code in your own programs (and may compile it into a program and distribute it in compiled format for languages that allow it) freely and with no charge.
  2. You MAY NOT redistribute this code (for example to a web site) without written permission from the original author. Failure to do so is a violation of copyright laws.   
  3. You may link to this code from another website, but ONLY if it is not wrapped in a frame. 
  4. You will abide by any additional copyright restrictions which the author may have placed in the code or code's description. 
				
'**************************************
' Name: cAspImage
' Description:cAspImage is a vbscript class that lets you read various properties from image files, including width, height and color depth. This cannot be done directly with ASP/vbscript because this type of information has to be parsed out from the image file itself. Supported file formats are PNG, GIF, BMP and JPG.
' By: Terje Hauger
'
'This code is copyrighted and has' limited warranties.Please see http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=9209&lngWId=4'for details.'**************************************

============================================================
STEP 1: SAVE THE FOLLOWING CODE AS cAspImage.asp:
============================================================
<%
'============================================================
' MODULE:cAspImage.asp
' AUTHOR:© www.u229.no
' CREATED: May 2005
'============================================================
' COMMENT:
' Read Image Properties from BMP, GIF, PNG and JPG files.
' Requirements: Microsoft Data Access Components installed on Web Server.
' PLEASE NOTE: Some JPEG files contain Thumbnails. In those cases this code will fail because
' it will think that the thumbnail's width/height are the "real" values.
' If this is a concern see more info on line 151.
'============================================================
' TODO:
'============================================================
' ROUTINES:
' - Private Sub Class_Initialize()
' - Private Sub Class_Terminate()
' - Public Function ReadImage(sFullPath)
' - Private Function ReadByteArray(sFullPath)
' - Private Sub EmptyVariables()
'============================================================
Class cAspImage
'// MODULE VARIABLES
Private m_arrBytes'// Byte array holding the image file
Private m_lWidth'// Width in pixels
Private m_lHeight '// Height in pixels
Private m_iColorDepth'// Color Depth (BitsPerPixel)
Private m_lImageSize'// # Bytes in image
Private m_sDateCreated'// Date Created
Private m_sLastModified '// Date last saved
Private m_sImageType '// PNG, JPG, GIF87a/GIF89a, BMP
Private m_sErrorMsg '// Error message: Check this if ReadImage returns false
'// PROPERTIES
Public Property Get Width()
Width = m_lWidth
End Property
Public Property Get Height()
Height = m_lHeight
End Property
Public Property Get ColorDepth()
ColorDepth = m_iColorDepth
End Property
Public Property Get ImageSize()
ImageSize = m_lImageSize
End Property
Public Property Get DateCreated()
DateCreated = m_sDateCreated
End Property
Public Property Get DateLastModified()
DateLastModified = m_sLastModified
End Property
Public Property Get ImageType()
ImageType = m_sImageType
End Property
Public Property Get ErrorMessage()
ErrorMessage = m_sErrorMsg
End Property
'------------------------------------------------------------------------------------------------------------
' Comment: Init module variables.
'------------------------------------------------------------------------------------------------------------
Private Sub Class_Initialize()
On Error Resume Next
Call EmptyVariables
End Sub
'------------------------------------------------------------------------------------------------------------
' Comment: Clean up.
'------------------------------------------------------------------------------------------------------------
Private Sub Class_Terminate()
End Sub
'------------------------------------------------------------------------------------------------------------
' Comment: Main routine returning the image properties.
'------------------------------------------------------------------------------------------------------------
Public Function ReadImage(sFullPath)
'On Error Resume Next
Dim oFSO
Dim oFile
Dim i
Dim bStop
	Dim lTmpHeight
	Dim lTmpWidth
	Dim iTmpDepth
'// These 3 are created to speed up the looping.
Dim i4
Dim byteTmp
Dim lSafeSize
Call EmptyVariables
bStop = False
If IsEmpty(oFSO) Then Set oFSO = Server.CreateObject("Scripting.FileSystemObject")
If oFSO.FileExists(sFullPath) Then
Set oFile = oFSO.GetFile(sFullPath)
m_lImageSize = oFile.Size
m_sDateCreated = FormatDateTime(oFile.DateCreated, 2)
m_sLastModified = FormatDateTime(oFile.DateLastModified, 2)
If Not ReadByteArray(sFullPath) Then m_sErrorMsg = "Error Reading Image File"
'---------------------------- GIF
If AscB(MidB(m_arrBytes, 1, 1)) = 71 And AscB(MidB(m_arrBytes, 2, 1)) = 73 And AscB(MidB( _
m_arrBytes, 3, 1)) = 70 Then
m_sImageType = "GIF89a"
If AscB(MidB(m_arrBytes, 5, 1)) = 55 Then m_sImageType = "GIF87a"
m_lWidth = CLng(AscB(MidB(m_arrBytes, 7, 1)) + (AscB(MidB(m_arrBytes, 8, 1)) * 256))
m_lHeight = CLng(AscB(MidB(m_arrBytes, 9, 1)) + (AscB(MidB(m_arrBytes, 10, 1)) * 256))
m_iColorDepth = 2 ^ ((Asc(CStr(AscB(MidB(m_arrBytes, 11, 1)))) And 7) + 1)
bStop = True
End If
'---------------------------- JPG
		If Not bStop Then
			If AscB(MidB(m_arrBytes, 1, 1)) = 255 And AscB(MidB(m_arrBytes, 2, 1)) = 216 And AscB(MidB( _
							m_arrBytes, 3, 1)) = 255 And AscB(MidB(m_arrBytes, 4, 1)) = 224 Then
				m_sImageType = "JPG"
				lSafeSize = (m_lImageSize - 1)
				For i = 5 To lSafeSize
					If AscB(MidB(m_arrBytes, i, 1)) = 255 Then
						byteTmp = AscB(MidB(m_arrBytes, i + 1, 1))
						If (byteTmp > 191) And (byteTmp < 208) Then
						
						i4 = AscB(MidB(m_arrBytes, i + 4, 1))
'=============================================================================================
'// Some JPEG files contain Thumbnails. In those cases this code will fail because it will think that the thumbnail's width/height are the "real" values.
'// If you care about the "thumbnail problem" you may comment existing code/uncomment the other lines below.
'// Be aware that this will dramatically slow down the looping time because we then will have to loop through the whole file(s)
							m_lHeight = CLng(AscB(MidB(m_arrBytes, i + 6, 1)) + (AscB(MidB(m_arrBytes, i + 5, 1)) * 256))
							m_lWidth = CLng(AscB(MidB(m_arrBytes, i + 8, 1)) + (AscB(MidB(m_arrBytes, i + 7, 1)) * 256))
							m_iColorDepth = CInt(i4) * CInt(AscB(MidB(m_arrBytes, i + 9, 1)))
'							lTmpHeight = CLng(AscB(MidB(m_arrBytes, i + 6, 1)) + (AscB(MidB(m_arrBytes, i + 5, 1)) * 256))
'							lTmpWidth = CLng(AscB(MidB(m_arrBytes, i + 8, 1)) + (AscB(MidB(m_arrBytes, i + 7, 1)) * 256))
'							iTmpDepth = CInt(i4) * CInt(AscB(MidB(m_arrBytes, i + 9, 1)))
'
							If m_iColorDepth > 0 And (i4 > 1 And i4 < 17) Then
'							If iTmpDepth > 0 And (i4 > 1 And i4 < 17) Then
'								If (lTmpHeight > m_lHeight) Or (lTmpWidth > m_lWidth) Then
'									m_lHeight = lTmpHeight
'									m_lWidth = lTmpWidth
'									m_iColorDepth = iTmpDepth
Exit For
'								End If
							End If
'=============================================================================================
						End If
					End If
				Next
				bStop = True
			End If
		End If
'---------------------------- PNG
If Not bStop Then
If AscB(MidB(m_arrBytes, 1, 1)) = 137 And AscB(MidB(m_arrBytes, 2, 1)) = 80 And AscB( _
MidB(m_arrBytes, 3, 1)) = 78 And AscB(MidB(m_arrBytes, 4, 1)) = 71 _
And AscB(MidB(m_arrBytes, 5, 1)) = 13 And AscB(MidB(m_arrBytes, 6, _
1)) = 10 And AscB(MidB(m_arrBytes, 7, 1)) = 26 And AscB(MidB(m_arrBytes, 8, 1)) = 10 Then
m_sImageType = "PNG"
m_lWidth = CLng(AscB(MidB(m_arrBytes, 20, 1)) + (AscB(MidB(m_arrBytes, 19, 1)) * 256))
m_lHeight = CLng(AscB(MidB(m_arrBytes, 24, 1)) + (AscB(MidB(m_arrBytes, 23, 1)) * 256))
Select Case CInt(AscB(MidB(m_arrBytes, 26, 1))) '// Get Bit Depth
Case 0
m_iColorDepth = CInt(AscB(MidB(m_arrBytes, 25, 1))) '// Grayscale
Case 2
m_iColorDepth = CInt(AscB(MidB(m_arrBytes, 25, 1))) * 3'// RGB encoded
Case 3
m_iColorDepth = 8 '// Palette based, 8 bpp
Case 4
m_iColorDepth = CInt(AscB(MidB(m_arrBytes, 25, 1))) * 2'// greyscale with alpha
Case 6
m_iColorDepth = CInt(AscB(MidB(m_arrBytes, 25, 1))) * 4'// RGB encoded with alpha
Case Else
End Select
bStop = True
End If
End If
'---------------------------- BMP
If Not bStop Then
If AscB(MidB(m_arrBytes, 1, 1)) = 66 And AscB(MidB(m_arrBytes, 2, 1)) = 77 Then
m_sImageType = "BMP"
m_lWidth = CLng(AscB(MidB(m_arrBytes, 19, 1)) + (AscB(MidB(m_arrBytes, 20, 1)) * 256))
m_lHeight = CLng(AscB(MidB(m_arrBytes, 23, 1)) + (AscB(MidB(m_arrBytes, 24, 1)) * 256))
m_iColorDepth = CInt(AscB(MidB(m_arrBytes, 29, 1)))
bStop = True
End If
End If
'----------------------------
Else
m_sErrorMsg = "Error in File Path: " & sFullPath
End If
Set oFile = Nothing
Set oFSO = Nothing
ReadImage = (Err.Number = 0)
End Function
'------------------------------------------------------------------------------------------------------------
' Comment: Read image into byte array.
'------------------------------------------------------------------------------------------------------------
Private Function ReadByteArray(sFullPath)
On Error Resume Next
Dim oStream
If IsEmpty(oStream) Then Set oStream = Server.CreateObject("ADODB.Stream")
With oStream
.Type = 1 '// adTypeBinary
.Open
.LoadFromFile sFullPath
m_arrBytes = .Read
End With
oStream.Close
Set oStream = Nothing
ReadByteArray = (Err.Number = 0)
End Function
'------------------------------------------------------------------------------------------------------------
' Comment: Set module variables empty.
'------------------------------------------------------------------------------------------------------------
Private Sub EmptyVariables()
On Error Resume Next
m_lWidth = 0
m_lHeight = 0
m_iColorDepth = 0
m_lImageSize = 0
m_sDateCreated = ""
m_sLastModified = ""
m_sImageType = "Unknown"
m_sErrorMsg = ""
End Sub
End Class
%>
===========================================
STEP 2: SAVE THE FOLLOWING AS start.asp IN THE SAME FOLDER AS ABOVE.
ALSO PUT A GIF FILE INTO THE SAME FOLDER AND NAME IT test.gif.
THEN POINT YOUR BROWSER TO start.asp.
===========================================
<% @Language="VBScript" %>
<%
Option Explicit
'On Error Resume Next
%>
<!--#include file="cAspImage.asp"-->
<%
'// HOW TO USE THIS CODE:
Dim oAspImg
Set oAspImg = New cAspImage
With oAspImg
.ReadImage(Server.MapPath("test.gif"))
	Response.Write "ImageSize: " & .ImageSize & "<br />"
	Response.Write "Date Created: " & .DateCreated & "<br />"
	Response.Write "Date Last Modified: " & .DateLastModified & "<br />"
	Response.Write "ColorDepth: " & .ColorDepth & "<br />"
	Response.Write "Width: " & .Width & "<br />"
	Response.Write "Height: " & .Height & "<br />"
	Response.Write "ImageType: " & .ImageType & "<br />"
	Response.Write "Error Message: " & .ErrorMessage & "<br />"
End With
Set oAspImg = Nothing
%>


Other 8 submission(s) by this author

 
Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:
Your Vote

What do you think of this code (in the Advanced category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 
Other User Comments

6/10/2005 8:20:28 AM: 

I was looking for somethink like this. You delivered just in time. Good work man. 5* 4 u.
(If this comment was disrespectful, please report it.)
 
6/12/2005 3:30:31 AM: 

10x mate looks good i will check it i think it would be great to support isAnimateGif()
(If this comment was disrespectful, please report it.)
 
6/20/2005 6:14:14 PM: Tom Bruinsma

than you for the code, you wouldnt happen to know where i could find the map for the rest of the properties? Such as ftop, aperature, etc.?

5 globes from me
(If this comment was disrespectful, please report it.)
 
Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular code, please click here instead.)
 

To post feedback, first please login.

Search:

Newest postings for ASP/ VbScript.

Add this ticker to my site

Daily code email

Click here to join the 'Code of the Day' mailing list!

This site on CD

Over 7,000 submissions on a super fast CD!

Code/Articles

Top Code

Community

Jobs

Other

Goto…

Copyright© 1997-2013 by Exhedra Solutions, Inc. All Rights Reserved.
By using this site you agree to its Terms and Conditions. Planet Source Code™ and the phrase "Dream It. Code It"™ are trademarks of Exhedra Solutions, Inc.