cAspImage (ing)

Bu kod ile çalıştırdığınız klasör içindeki resimlerin detaylı bilgilerini veriyor.Boyut, isim, en, boy gibi özellikler gösteriliyor.

Aşağıdaki kodu herhangi bir isimde kayıt etmeniz yeterli olacaktır.Sonra çalıştırabilirsiniz.

Uygulama ile aynı klasörde olan belirtilmiş resmin özelliklerini veriyor.Kodun en aşağısında bulunun "test.gif" dosya adı deneme amaçlı olduğu için resmin özelliklerini almak için kendi resminizin ismini yazmanız gerekmektedir.



************************************************** ********************





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

'// HOW TO USE THIS CODE:





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



%>