Return Image Type and Size from JPEG, GIF, BMP, PNG, and TIFF files.

Category:

Screen/Graphics

Type:

Classes

Difficulty:

Intermediate

Author: Anonymous

Version Compatibility: Visual Basic.NET

More information:

This class module will return the height, width, color depth, and image type information from the following image formats: JPEG, GIF, BMP, PNG, & TIFF.

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
Option Explicit On Imports System Imports System.Drawing

Code:

''' <summary>
''' The ImageLoader class can retrieve image metadata using very little memory.
''' </summary>
''' <remarks>After constructing an ImageLoader, the object will expose
''' properties including file type, height, width, bits per pixel, etc.
''' The caller should first check that Type is not equal xNone
''' to confirm the object was constructed successfully.
''' 
''' There are two methods that add more functionality: LoadBitmap and UnloadBitmap.
''' These control when and how the Bitmap property is loaded into memory.
''' 
''' Submitted by Robert Chapin
''' Chapin Information Services, Inc.  http://www.info-svc.com/
''' 24 January 2008
''' 
''' This class is based on and inspired by David Crowell's code from
''' http://www.freevbcode.com/ShowCode.Asp?ID=112
''' Parts that were obviously buggy or not working in Mr Crowell's version
''' have been corrected.  The rest of his algorithm is essentially unchanged.
''' 
''' This class is being published in like kind at www.freevbcode.com
''' It is also being used in the latest beta version of ThetaWall at
''' http://www.info-svc.com/software/thetawall/
''' 
''' <example><code>
''' Dim MyImage As New ImageLoader("C:\myfolder\pic1.jpg")
''' If ExtraImage.Type = ImageLoader.ImageType.JPEG Then
'''     Debug.Print(MyImage.Width.ToString)
'''     MyImage.LoadBitmap()
'''     Debug.Print(MyImage.Bitmap.Width.ToString)
''' End If
''' </code></example>
''' </remarks>
''' <permission cref="Security.Permissions.FileIOPermission">The class constructor
''' will throw a System.Security.SecurityException object if it is run from
''' a network drive in the default environment.  This is caused by .NET performing
''' an implicit security check before executing the Sub New().  It is assumed
''' all security matters are being handled by the caller and are outside the
''' intended scope of this class.</permission>
Public Class ImageLoader

Private FullImage As Bitmap
    Private Dimensions As New Size(0, 0)
    Private ImageBPP As Integer
    Private FilePath As String
    Private FileSize As Integer
    Private FileType As ImageType = ImageType.xNone

Public Enum ImageType As Integer
        ''' <summary>
        ''' The xNone type indicates the object is empty or failed to load an image file.
        ''' </summary>
        ''' <remarks></remarks>
        xNone = 0
        GIF = 1
        JPEG = 2
        PNG = 3
        BMP = 4
        TIFF = 5
    End Enum

''' <summary>
    ''' Creates an ImageLoader object, then reads metadata from the specified path.
    ''' </summary>
    ''' <param name="Path">Absolute path to any supported image file.</param>
    ''' <remarks>A massive memory savings is achieved by not using a Bitmap object to retrieve metadata.</remarks>
    Public Sub New(ByRef Path As String)

FilePath = Path
        Try
            FileSize = FileLen(Path)
            ReadImageInfo()
        Catch ex As Exception
            FailedImageHandler(ex, Path)
        End Try

End Sub

#Region "Properties and Methods"

''' <summary>
    ''' Holds a System.Drawing.Bitmap object 
    ''' </summary>
    ''' <value>GDI+ Bitmap</value>
    ''' <returns></returns>
    ''' <remarks>Loaded with a valid image after calling the LoadBitmap() method.
    ''' At all other times, IsNothing(ImageLoader.Bitmap) === True</remarks>
    Public ReadOnly Property Bitmap() As Bitmap
        Get
            Bitmap = FullImage
        End Get
    End Property

''' <summary>
    ''' Image sample size in Bits Per Pixel
    ''' </summary>
    ''' <value>Typically 1 - 48 bpp</value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public ReadOnly Property ColorDepth() As Integer
        Get
            ColorDepth = ImageBPP
        End Get
    End Property

''' <summary>
    ''' Image height in pixels
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public ReadOnly Property Height() As Integer
        Get
            Height = Dimensions.Height
        End Get
    End Property

''' <summary>
    ''' Size of the image file in bytes
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public ReadOnly Property Length() As Integer
        Get
            Length = FileSize
        End Get
    End Property

''' <summary>
    ''' Reads the entire image file into the Bitmap property
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function LoadBitmap() As Boolean
        LoadBitmap = False
        If FileType <> ImageType.xNone Then
            Try
                FullImage = New Bitmap(FilePath)
                LoadBitmap = True
            Catch ex As Exception
                FailedImageHandler(ex, FilePath)
            End Try
        End If
    End Function

''' <summary>
    ''' The path that was used to contruct the ImageLoader.
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public ReadOnly Property Path() As String
        Get
            Path = FilePath
        End Get
    End Property

''' <summary>
    ''' The image dimensions as a System.Drawing.Size object.
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public ReadOnly Property Size() As Size
        Get
            Size = Dimensions
        End Get
    End Property

''' <summary>
    ''' The image type detected by the ImageLoader constructor.
    ''' </summary>
    ''' <value>ImageLoader.ImageType enumeration</value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public ReadOnly Property Type() As ImageType
        Get
            Type = FileType
        End Get
    End Property

''' <summary>
    ''' Frees memory referenced by the Bitmap property.
    ''' </summary>
    ''' <remarks>This method can be used when the Bitmap is no longer needed.
    ''' The ImageLoader will retain its metadata until it passes out of scope.</remarks>
    Public Sub UnLoadBitmap()
        FullImage = Nothing
    End Sub

''' <summary>
    ''' Image width in pixels.
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public ReadOnly Property Width() As Integer
        Get
            Width = Dimensions.Width
        End Get
    End Property

#End Region 'Properties and Methods

#Region "Member Functions"

''' <summary>
    ''' Performs all failure mode tasks for Exceptions thrown during file reads.
    ''' </summary>
    ''' <param name="ex">The Exception object caught by the caller.</param>
    ''' <param name="Path">The absolute path to the file that threw the Exception.</param>
    ''' <remarks>FailedImageHandler() is called automatically by LoadBitmap() and ReadImageInfo().
    ''' This is an ideal place to centralize file error handling.</remarks>
    Private Sub FailedImageHandler(ByRef ex As Exception, ByRef Path As String)
        FileType = ImageType.xNone
        Select Case _
        MsgBox(My.Application.Info.Title & " was unable to render an image from" & vbCrLf & FilePath & vbCrLf & vbCrLf _
             & "Click Abort to close " & My.Application.Info.Title & " and view the folder." & vbCrLf _
             & "Click Retry to rename the file using *.bad" & vbCrLf _
             & "Click Ignore to continue with the error.", MsgBoxStyle.AbortRetryIgnore, "Image File Problem")

Case MsgBoxResult.Abort
                Process.Start(Left(Path, InStrRev(Path, "\")))
                End
            Case MsgBoxResult.Retry
                Try
                    My.Computer.FileSystem.MoveFile(Path, Path & ".bad")
                Catch ex2 As Exception
                    MsgBox("Unable to rename file.  " & ex2.Message, MsgBoxStyle.Information, "Rename Failed")
                End Try
        End Select
    End Sub

''' <summary>
    ''' Reads image headers to determine the file type and attributes. (metadata)
    ''' </summary>
    ''' <remarks></remarks>
    Private Sub ReadImageInfo()

'Define constants
        Const BUFFERSIZE As Integer = 4096
        Const MinimumFileLength As Integer = 25 'Files smaller than this number of bytes are treated as invalid.
        Const TIFFFieldLen As Integer = 12 'Each field in the IFD is 12 bytes long.

Dim BMPHeader() As Byte = {66, 77}
        Dim GIFHeader() As Byte = {71, 73, 70}
        Dim JPEGHeader() As Byte = {&HFF, &HD8, &HFF}
        Dim PNGHeader() As Byte = {137, 80, 78, 71, 13, 10, 26, 10}
        Dim TIFFHeader() As Byte = {&H49, &H49, &H2A, &H0}
        Dim TIFFHeaderRev() As Byte = {&H4D, &H4D, &H0, &H2A}
        Dim TIFFWidthTag() As Byte = {&H0, &H1}
        Dim TIFFWidthTagRev() As Byte = {&H1, &H0}
        Dim TIFFHeightTag() As Byte = {&H1, &H1}
        Dim TIFFDepthTag() As Byte = {&H2, &H1}
        Dim TIFFDepthTagRev() As Byte = {&H1, &H2}

'Dimension locals
        Dim NormalByteOrder As Boolean 'Normal here means string byte order, where the least-significant byte is stored first.

Dim BufferedBytes As Integer 'Used in all buffer flow checks.
        Dim FileOffset As Integer = 0 'Tracks where the buffer begins.  Not the same as stream.position which can be beyond EOF.
        Dim TempPos As Integer 'Position within the buffer.
        Dim TempField As Integer 'Receives return values and flags.
        Dim TIFFHeaderLen As Integer 'Receives the IFD offset, which will be at least 8 bytes followed by a 2-byte count of fields.

Dim bBuf(BUFFERSIZE - 1) As Byte 'Arrays are zero-based and (n) is UBound, not Count.

'Open the image file.
        Dim InStream As New IO.FileStream(FilePath, IO.FileMode.Open, IO.FileAccess.Read, IO.FileShare.Read)

'Read the file and fill the buffer.
        BufferedBytes = InStream.Read(bBuf, 0, BUFFERSIZE)

'Check buffer underflow.
        If BufferedBytes < MinimumFileLength Then GoTo ErrorOut

If bBuf(0) = PNGHeader(0) AndAlso _
           bBuf(1) = PNGHeader(1) AndAlso _
           bBuf(2) = PNGHeader(2) AndAlso _
           bBuf(3) = PNGHeader(3) AndAlso _
           bBuf(4) = PNGHeader(4) AndAlso _
           bBuf(5) = PNGHeader(5) AndAlso _
           bBuf(6) = PNGHeader(6) AndAlso _
           bBuf(7) = PNGHeader(7) Then
            ' this is a PNG file

FileType = ImageType.PNG
            NormalByteOrder = False

' get bit depth
            Select Case bBuf(25)
                Case 0
                    ' greyscale
                    ImageBPP = bBuf(24)

Case 2
                    ' RGB encoded
                    ImageBPP = bBuf(24) * 3

Case 3
                    ' Palette based, 8 bpp
                    ImageBPP = 8

Case 4
                    ' greyscale with alpha
                    ImageBPP = bBuf(24) * 2

Case 6
                    ' RGB encoded with alpha
                    ImageBPP = bBuf(24) * 4

Case Else
                    ' This value is outside of it's normal range, so we'll assume
                    ' that this is not a valid file
                    FileType = ImageType.xNone

End Select

If FileType <> ImageType.xNone Then
                ' if the image is valid then

' get the width  'Note: Reverse byte order
                Dimensions.Width = Mult(bBuf(16), bBuf(17), bBuf(18), bBuf(19), NormalByteOrder)

' get the height
                Dimensions.Height = Mult(bBuf(20), bBuf(21), bBuf(22), bBuf(23), NormalByteOrder)
            End If

ElseIf bBuf(0) = GIFHeader(0) AndAlso _
               bBuf(1) = GIFHeader(1) AndAlso _
               bBuf(2) = GIFHeader(2) Then
            ' this is a GIF file

FileType = ImageType.GIF
            NormalByteOrder = True

' get the width
            Dimensions.Width = Mult(bBuf(6), bBuf(7), NormalByteOrder)

' get the height
            Dimensions.Height = Mult(bBuf(8), bBuf(9), NormalByteOrder)

' get bit depth
            ImageBPP = (bBuf(10) And 7) + 1

ElseIf bBuf(0) = BMPHeader(0) AndAlso _
               bBuf(1) = BMPHeader(1) Then
            ' this is a BMP file

FileType = ImageType.BMP
            NormalByteOrder = True

' get the width
            Dimensions.Width = Mult(bBuf(18), bBuf(19), NormalByteOrder)

' get the height
            Dimensions.Height = Mult(bBuf(22), bBuf(23), NormalByteOrder)

' get bit depth
            ImageBPP = bBuf(28)

ElseIf bBuf(0) = bBuf(1) AndAlso (bBuf(0) = TIFFHeader(0) OrElse bBuf(0) = TIFFHeaderRev(0)) Then
            ' this is a TIFF file

NormalByteOrder = (bBuf(0) = TIFFHeader(0))

'Test for valid byte order on second word, a 16-bit representation of decimal 42.
            If Mult(bBuf(2), bBuf(3), NormalByteOrder) = 42 Then
                FileType = ImageType.TIFF
            Else
                FileType = ImageType.xNone
            End If

'Find the Image File Directory (IFD)
            If FileType <> ImageType.xNone Then

'Note: The IFD may appear AFTER the payload.

'First read the offset
                TIFFHeaderLen = Mult(bBuf(4), bBuf(5), bBuf(6), bBuf(7), NormalByteOrder)

If TIFFHeaderLen + 2 + TIFFFieldLen * 4 >= BufferedBytes Then 'Must seek end of payload.

FileOffset = TIFFHeaderLen
                    If FileOffset < InStream.Length Then
                        InStream.Position = FileOffset
                        BufferedBytes = InStream.Read(bBuf, 0, BUFFERSIZE)
                        TIFFHeaderLen = 0
                    Else
                        FileType = ImageType.xNone
                    End If

End If

'Now find the Width tag, 
                TempField = 0
                For TempPos = TIFFHeaderLen + 2 To BufferedBytes - 1 Step TIFFFieldLen

If NormalByteOrder Then
                        If bBuf(TempPos) = TIFFWidthTag(0) AndAlso bBuf(TempPos + 1) = TIFFWidthTag(1) Then
                            TempField = 1
                            Exit For
                        End If
                    ElseIf bBuf(TempPos) = TIFFWidthTagRev(0) AndAlso bBuf(TempPos + 1) = TIFFWidthTagRev(1) Then
                        TempField = 1
                        Exit For
                    End If

If TempField = 0 Then FileType = ImageType.xNone

End If

'Find the Width
            If FileType <> ImageType.xNone Then

'Get Number Type
                TempField = Mult(bBuf(TempPos + 2), bBuf(TempPos + 3), NormalByteOrder)

'Get Width Number
                If TempField = 3 Then
                    Dimensions.Width = Mult(bBuf(TempPos + 8), bBuf(TempPos + 9), NormalByteOrder)
                ElseIf TempField = 4 Then
                    Dimensions.Width = Mult(bBuf(TempPos + 8), bBuf(TempPos + 9), bBuf(TempPos + 10), bBuf(TempPos + 11), NormalByteOrder)
                Else
                    FileType = ImageType.xNone
                End If

End If

'Find the Height
            If FileType <> ImageType.xNone Then

TempPos += TIFFFieldLen

'Get Number Type
                TempField = Mult(bBuf(TempPos + 2), bBuf(TempPos + 3), NormalByteOrder)

'Get Height Number
                If TempField = 3 Then
                    Dimensions.Height = Mult(bBuf(TempPos + 8), bBuf(TempPos + 9), NormalByteOrder)
                ElseIf TempField = 4 Then
                    Dimensions.Height = Mult(bBuf(TempPos + 8), bBuf(TempPos + 9), bBuf(TempPos + 10), bBuf(TempPos + 11), NormalByteOrder)
                Else
                    FileType = ImageType.xNone
                End If

End If

'Find the Color Depth
            If FileType <> ImageType.xNone Then

TempPos += TIFFFieldLen

'Check if BPP Field is Present, else BPP defaults to 1.
                ImageBPP = 0
                If NormalByteOrder Then
                    If Not (bBuf(TempPos) = TIFFDepthTag(0) AndAlso bBuf(TempPos + 1) = TIFFDepthTag(1)) Then ImageBPP = 1
                Else
                    If Not (bBuf(TempPos) = TIFFDepthTagRev(0) AndAlso bBuf(TempPos + 1) = TIFFDepthTagRev(1)) Then ImageBPP = 1
                End If

If ImageBPP = 0 Then

'Check count of BPP numbers
                    TempField = Mult(bBuf(TempPos + 4), bBuf(TempPos + 5), bBuf(TempPos + 6), bBuf(TempPos + 7), NormalByteOrder)

'Extract BPP numbers
                    If TempField <= 2 Then 'Value(s) will fit in field.
                        ImageBPP = Mult(bBuf(TempPos + 8), bBuf(TempPos + 9), NormalByteOrder)
                        If TempField = 2 Then
                            ImageBPP += Mult(bBuf(TempPos + 10), bBuf(TempPos + 11), NormalByteOrder)
                        End If

Else 'Must get the file offset of the BPP numbers
                        TempPos = Mult(bBuf(TempPos + 8), bBuf(TempPos + 9), bBuf(TempPos + 10), bBuf(TempPos + 11), NormalByteOrder)

If TempPos > FileOffset + BufferedBytes - 2 Then

FileOffset = TempPos
                            If FileOffset < InStream.Length Then
                                InStream.Position = TempPos
                                BufferedBytes = InStream.Read(bBuf, 0, BUFFERSIZE)
                            Else
                                FileType = ImageType.xNone
                            End If

End If

'Extract BPP Numbers
                        For Counter As Integer = 0 To TempField - 1
                            ImageBPP += Mult(bBuf(TempPos + Counter), bBuf(TempPos + Counter + 1), NormalByteOrder)
                        Next
                    End If
                End If
            End If

If FileOffset <> 0 AndAlso FileType = ImageType.xNone Then 'Reset buffer
                FileOffset = 0
                InStream.Position = FileOffset
                BufferedBytes = InStream.Read(bBuf, 0, BUFFERSIZE)
            End If

End If

If FileType = ImageType.xNone Then
            ' if the file is not one of the above types then
            ' check to see if it is a JPEG file

NormalByteOrder = False

TempField = 0
            TempPos = 0
            Do While TempField = 0 And TempPos < BufferedBytes - 10
                ' loop through looking for the byte sequence FF,D8,FF
                ' which marks the begining of a JPEG file
                ' lPos will be left at the postion of the start
                If bBuf(TempPos) = JPEGHeader(0) AndAlso _
                   bBuf(TempPos + 1) = JPEGHeader(1) AndAlso _
                   bBuf(TempPos + 2) = JPEGHeader(2) Then TempField = 1

Loop
            If TempField = 1 Then

TempPos += 2

TempField = 0
                Do While TempField = 0 And FileOffset < InStream.Length
                    ' loop through the markers until we find the one 
                    'starting with FF,C0 which is the block containing the 
                    'image information

Do While Not (bBuf(TempPos) = &HFF AndAlso bBuf(TempPos + 1) <> &HFF)
                        ' loop until we find the beginning of the next marker
                        TempPos += 1
                        If (TempPos >= BufferedBytes - 10) Then GoTo ErrorOut
                    Loop

' move pointer up
                    TempPos += 1

Select Case bBuf(TempPos)
                        Case &HC0 To &HC3, &HC5 To &HC7, &HC9 To &HCB, &HCD To &HCF
                            ' we found the right block
                            FileType = ImageType.JPEG
                            TempField = 1

Case Else
                            'Found an Application Data Segment (or equiv), which must be parsed for its payload length and then skipped.
                            TempPos += 1 'Corrects off-by-one error in original algorithm.
                            TempPos += Mult(bBuf(TempPos), bBuf(TempPos + 1), NormalByteOrder)

' check for end of buffer
                            If TempPos > BufferedBytes - 10 Then
                                FileOffset += TempPos
                                If FileOffset < InStream.Length Then
                                    InStream.Position = FileOffset
                                    BufferedBytes = InStream.Read(bBuf, 0, BUFFERSIZE)
                                    TempPos = 0
                                Else
                                    TempField = 1 'Error Out
                                End If
                            End If
                    End Select

Loop

If FileType = ImageType.JPEG Then
                    ' get the height
                    Dimensions.Height = Mult(bBuf(TempPos + 4), bBuf(TempPos + 5), NormalByteOrder)

' get the width
                    Dimensions.Width = Mult(bBuf(TempPos + 6), bBuf(TempPos + 7), NormalByteOrder)

' get the color depth
                    ImageBPP = bBuf(TempPos + 8) * 8
                End If
            End If
        End If

ErrorOut:
        InStream.Close()

If FileType = ImageType.xNone Then
            Err.Raise(531, "ImageParser", "Unable to decode image headers.")
        End If

End Sub

''' <summary>
    ''' Coverts 2 Bytes into an Integer
    ''' </summary>
    ''' <param name="lsb">The least-significant byte</param>
    ''' <param name="msb">The most-significant byte</param>
    ''' <param name="NormalByteOrder">Must be set to False when providing parameters in reverse order.</param>
    ''' <returns>32-bit Signed Integer</returns>
    ''' <remarks>Parameters are in left-to-right (string) order.</remarks>
    Private Overloads Function Mult(ByVal lsb As Byte, ByVal msb As Byte, ByVal NormalByteOrder As Boolean) As Integer
        If NormalByteOrder Then
            Mult = (CInt(msb) << 8) Or CInt(lsb)
        Else
            Mult = (CInt(lsb) << 8) Or CInt(msb)
        End If
    End Function

''' <summary>
    ''' Coverts 4 Bytes into an Integer
    ''' </summary>
    ''' <param name="lsb">The least-significant byte</param>
    ''' <param name="m2b">The middle-second byte</param>
    ''' <param name="m3b">The middle-third byte</param>
    ''' <param name="msb">The most-significant byte</param>
    ''' <param name="NormalByteOrder">Must be set to False when providing parameters in reverse order.</param>
    ''' <returns>32-bit Signed Integer</returns>
    ''' <remarks>Parameters are in left-to-right (string) order.</remarks>
    Private Overloads Function Mult(ByVal lsb As Byte, ByVal m2b As Byte, ByVal m3b As Byte, ByVal msb As Byte, _
    ByVal NormalByteOrder As Boolean) As Integer
        If NormalByteOrder Then
            Mult = (CInt(msb) << 24) Or (CInt(m3b) << 16) Or (CInt(m2b) << 8) Or CInt(lsb)
        Else
            Mult = (CInt(lsb) << 24) Or (CInt(m2b) << 16) Or (CInt(m3b) << 8) Or CInt(msb)
        End If
    End Function

#End Region 'Member Functions

End Class