作者：未知 来源：月光软件站 加入时间：2005-2-28　月光软件站

这个是转载
Function ImageSize(fileName As String) As Variant
   ' Given a source file name (path to the GIF or JPG on disk), return an array containing
   ' the width (1st element) and height (2nd element).
   Dim retVal As Variant
   Dim header As String
   Dim f As Integer
   Dim wHi As Variant
   Dim wLo As Variant
   Dim hHi As Variant
   Dim hLo As Variant
   Dim w As Integer ' width of image
   Dim h As Integer ' height of image
   Dim foundMarker As Integer
   
   Redim retVal(2) As Integer
   Redim retVal(Lbound(retVal)+1)     ' Size it so there's 2 entries
   retVal(Lbound(retVal)) = 0
   retVal(Ubound(retVal)) = 0
   f = Freefile()
   On Error Resume Next
   Open fileName For Input As #f
   On Error Goto 0
   If Err <> 0 Then
      ImageSize = retVal  ' File name incorrect - return zero for both the height and width
      Exit Function
   End If
   If Lcase(Right(fileName, 3)) = "gif" Then
      ' GIF's height and width stored in a fixed location
      header = Input(10, f)
      wHi = Mid(header, 8, 1)
      wLo = Mid(header, 7, 1)
      hHi = Mid(header, 10, 1)
      hLo = Mid(header, 9, 1)
      w = Asc(wHi) * 256 + Asc(wLo)
      h = Asc(hHi) * 256 + Asc(hLo)
   Elseif Lcase(Right(fileName, 3)) = "jpg" Then
      ' JPG's stored in a variable location. The code has been verified with JFIF
      ' file format (the most common format)
      On Error Goto EndOfFile     ' In case we run over the file for some reason
      header = Input(2, f)
      If header = Chr$(255) & Chr$(216) Then   ' Must start with hex FF D8
         foundMarker = False   ' Look for the marker that will contain the height and width
         While Not foundMarker
            header = Input(2, f)    ' Grab the next marker
            ' Look for the marker (in hex) FF C0, FF C1, FF C2, or FF C3
            If header = Chr$(255) & Chr$(192) Or header = Chr$(255) & Chr$(193) _
            Or header = Chr$(255) & Chr$(194) Or header = Chr$(255) & Chr$(195) Then
               ' Next two bytes are the length, then a single byte that can be ignored.
               header = Input(3, f)
               ' Next two bytes are the height of the image
               header = Input(2, f)
               hHi = Asc(Midbp(header, 1, 1))
               hLo = Asc(Midbp(header, 2, 1))
               h = hHi * 256 + hLo
               ' Next two bytes are the width of the image
               header = Input(2, f)
               wHi = Asc(Midbp(header, 1, 1))
               wLo = Asc(Midbp(header, 2, 1))
               w = wHi * 256 + wLo
               foundMarker = True     ' Exit the while loop
            Else   ' It's not one of the special markers - skip over it
               header = Input(2, f)   ' Next two bytes are the marker length
               wHi = Asc(Midbp(header, 1, 1))
               wLo = Asc(Midbp(header, 2, 1))
               w = wHi * 256 + wLo
               header = Input(w-2, f) ' Skip over that many bytes (minus the 2 byte length already read)
               w = 0   ' Clear the variable
            End If
         Wend   ' Continue until the marker is found
      End If    ' Ends the check to see if the file starts with FF D8
EndOfFile:
      If Err <> 0 Then
         Err = 0
         Resume AfterError
      End If
   End If   ' Ends the check to see if the format is GIF or JPG
AfterError:
   retVal(Lbound(retVal)) = w
   retVal(Ubound(retVal)) = h
   Close #f
   ImageSize = retVal
End Function


Here's a sample GIFFile class cloning ImageSize() routine original logic:

Private Const GIF_HEADER_LENGTH = 10
Private Const GIF_MARKER = "GIF"
Private Const GIF_ID1 = "87a"
Private Const GIF_ID2= "89a"

Private Class GIFFile

Private m_w As Integer
Private m_h As Integer

Public Property Set fileName As String
Dim h ' GIF file Header: "GIF87a" or GIF89a" followed by logical width & height
h = Me.Header ' Let's check GIF format presence..
If ( Left$( h, 3 ) <> GIF_MARKER ) Then Error 1000, _
|Not a GIF file: Graphical Interchange File "GIF" marker not found|
If ( Mid$( h, 4, 3 ) <> GIF_ID1 And Mid$( h, 4, 3 ) <> GIF_ID2 ) Then Error 1002, _
|Not a GIF file: Graphical Interchange File "87a/89a" identifier not found|
m_w = Asc( Mid( h, 8, 1 ) ) * 256 + Asc( Mid( h, 7, 1 ) ) ' Little-endian Screen Width
m_h = Asc( Mid( h, 10, 1 ) ) * 256 + Asc( Mid( h, 9, 1 ) ) ' Little-endian Screen Height
End Property
Private Property Get Header As Variant
Dim h As Integer
h% = Freefile()
Open Me.Name For Input Shared As #h
Header = Input( GIF_HEADER_LENGTH, #h )
Close #h
End Property
Public Property Get Heigth As Integer
Heigth = m_h
End Property
Public Property Get Width As Integer
Me.Width = m_w
End Property

Public Sub new( fileName As String )
Me.FileName = fileName
End Sub

End Class

I have added GIF format additional checks intended to detect files holding inaccurate extension/type

相关软件：