<%
IMGPath="PoweredByAsp.Net.gif"
Dim ImgWHInfo
' 建立類對象
Set ImgWHInfo = New clsImgWHInfo
ImgWHInfo.File=IMGPath
Call ImgWHInfo.GetImgInfo
Response.write "Img類型: " & ImgWHInfo.ImgType & "<br>"
Response.write "寬: " & ImgWHInfo.Width & "<br>"
Response.write "高: " & ImgWHInfo.Height & "<br>"
Response.write "<hr>"
Response.Write "<img src='" & IMGPath & "' border=0><br>"
Set ImgWHInfo = Nothing
%>
<Script RunAt="Server" Language="VBScript">
'==========================================================================
'名稱：圖片信息類
'功能：獲取圖片寬度和高度，支持JPG，GIF，PNG，BMP
'運行環境：ADO 2.5以上/FSO
'作者：jimzhu 請保留
'版本：2.0
'日期：2004-12-08
'需指定的屬性
'File 文件的路徑
'可用方法
'GetImgInfo 執行
'==========================================================================
Class clsImgWHInfo
Private objStream
Private m_File,m_Type,m_Height,m_Width
Private Sub Class_Initialize
m_File = vbNullString
End Sub
Property Let File(ByVal value)
' If GetFileExt(value)=".mp3" Then m_File=value
m_File=value
End Property
Property Get ImgType()
ImgType=m_Type
End Property
Property Get Height()
Height=m_Height
End Property
Property Get Width()
Width=m_Width
End Property
Sub GetImgInfo()
Dim objFSO,IMGFile,FileExt,sFile
sFile=Server.MapPath(m_File)
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
If (objFSO.FileExists(sFile)) Then
FileExt=objFSO.GetExtensionName(sFile)
Select Case FileExt
Case "gif","bmp","jpg","jpeg","png","swf"
Call GetImageSize(sFile)
Case Else
m_Type="File isn;t an Image File."
End Select
Set IMGFile=Nothing
Else
m_Type="File Not Exists."
End If
Set objFSO=Nothing
End Sub
Private Sub GetImageSize(ByVal FullPath)
Dim bFlag
Set objStream=Server.CreateObject("ADODB.Stream")
objStream.Mode=3
objStream.Type=1
objStream.Open
objStream.LoadFromFile(FullPath)
bFlag=objStream.Read(3)
Select Case Hex(Bin2Val(bFlag))
Case "4E5089"
m_Type="PNG"
objStream.Position = objStream.Position + 15
m_Width=Bin2ValRev(objStream.Read(2))
objStream.Position = objStream.Position + 2
m_Height=Bin2ValRev(objStream.Read(2))
Case "464947"
m_Type="gif"
objStream.Position = objStream.Position + 3
m_Width=Bin2Val(objStream.Read(2))
m_Height=Bin2Val(objStream.Read(2))
Case "535746"
m_Type="SWF"
objStream.Position = objStream.Position + 5
sConv=Num2Str(AscB(objStream.Read(1)),2,8)
nBits=Str2Num(Left(sConv,5),2)
sConv=Mid(sConv,6)
While Len(sConv)<nBits*4
sConv=sConv&Num2Str(AscB(objStream.Read(1)),2,8)
Wend
m_Width=Int(Abs(Str2Num(Mid(sConv,1*nBits+1,nBits),2)-Str2Num(Mid(sConv,0*nBits+1,nBits),2))/20)
m_Height=Int(Abs(Str2Num(Mid(sConv,3*nBits+1,nBits),2)-Str2Num(Mid(sConv,2*nBits+1,nBits),2))/20)
Case "FFD8FF"
m_Type="JPG"
Dim iTmp
Do While True
Do
iTmp=Bin2Val(objStream.Read(1))
Loop Until iTmp<255 Or objStream.EOS
If iTmp>191 And iTmp<196 Then
Exit Do
Else
objStream.Position = objStream.Position + Bin2ValRev(objStream.Read(2))-2
End If
Do
iTmp=Bin2Val(objStream.Read(1))
Loop Until iTmp=255 Or objStream.EOS
Loop
objStream.Position = objStream.Position + 3
m_Height=Bin2ValRev(objStream.Read(2))
m_Width=Bin2ValRev(objStream.Read(2))
Case Else
If Left(Bin2Str(bFlag),2)="BM" Then
m_Type="BMP"
objStream.Position = objStream.Position + 15
m_Width=Bin2Val(objStream.Read(4))
m_Height=Bin2Val(objStream.Read(4))
Else
m_Type=""
End If
End Select
Err.Clear
objStream.Close
Set objStream=Nothing
End Sub
Private Function Bin2Str(ByVal BinStr)
Dim iChar,iCharLow,sRet,i,iLen
sRet = vbNullString
iLen=LenB(binstr)
For i=1 To iLen
iChar=AscB(MidB(BinStr,i,1))
If iChar > 127 Then
i=i+1
If i<=iLen Then sRet =sRet & Chr(iChar*&H100 + AscB(MidB(BinStr,i,1)))
Else
If iChar<>0 Then sRet = sRet & Chr(iChar)
End If
Next
Bin2Str = sRet
End Function
Private Function Num2Str(ByVal Num,ByVal Base,ByVal Lens)
Dim Ret
Ret = vbNullString
While Num>=Base
Ret = (Num Mod Base) & Ret
Num = (Num - Num Mod Base)/Base
Wend
Num2Str = Right(String(Lens,"0") & Num & Ret,Lens)
End Function
Private Function Str2Num(ByVal Str,ByVal Base)
Dim Ret,I,iLen
Ret = 0
iLen = Len(Str)
For I=1 To iLen
Ret = Ret*base + Cint(Mid(Str,I,1))
Next
Str2Num=Ret
End Function
Private Function Bin2Val(ByVal Bin)
Dim Ret,I,iLen
Ret = 0
iLen = LenB(Bin)
For I = iLen To 1 Step -1
Ret = Ret*&H100 + AscB(MidB(Bin,I,1))
Next
Bin2Val=Ret
End Function
Private Function Bin2ValRev(ByVal Bin)
Dim Ret,I
Ret = 0
iLen = LenB(Bin)
For I = 1 To iLen
Ret = Ret*&H100 + AscB(MidB(Bin,I,1))
Next
Bin2ValRev=Ret
End Function
'[獲取文件名後綴]
Private Function GetFileExt(ByVal FullPath)
Dim iTmp
GetFileExt = ""
iTmp=InStrRev(FullPath, ".")
If Not iTmp Then GetFileExt = LCase(Mid(FullPath,iTmp))
End Function
End Class
</SCRIPT>