ASP中取得图片宽度和高度的类（无组件）

 

  1<%
  2Class ImgWHInfo '获取图片宽度和高度的类，支持JPG，GIF，PNG，BMP
  3    Dim ASO
  4    Private Sub Class_Initialize
  5        Set ASO=Server.CreateObject("ADODB.Stream")
  6        ASO.Mode=3
  7        ASO.Type=1
  8        ASO.Open
  9    End Sub
 10    Private Sub Class_Terminate
 11        Err.Clear
 12        Set ASO=Nothing
 13    End Sub 
 14 
 15    Private Function Bin2Str(Bin)
 16        Dim I, Str
 17        For I=1 To LenB(Bin)
 18            clow=MidB(Bin,I,1)
 19            If ASCB(clow)<128 Then
 20                Str = Str & Chr(ASCB(clow))
 21            Else
 22                I=I+1
 23                If I <= LenB(Bin) Then Str = Str & Chr(ASCW(MidB(Bin,I,1)&clow))
 24            End If
 25        Next
 26        Bin2Str = Str
 27    End Function
 28      
 29    Private Function Num2Str(Num,Base,Lens)
 30        Dim Ret
 31        Ret = ""
 32        While(Num>=Base)
 33            Ret = (Num Mod Base) & Ret
 34            Num = (Num - Num Mod Base)/Base
 35        Wend
 36        Num2Str = Right(String(Lens,"0") & Num & Ret,Lens)
 37    End Function
 38      
 39    Private Function Str2Num(Str,Base) 
 40        Dim Ret,I
 41        Ret = 0 
 42        For I=1 To Len(Str) 
 43            Ret = Ret *base + Cint(Mid(Str,I,1)) 
 44        Next 
 45        Str2Num=Ret 
 46    End Function 
 47      
 48    Private Function BinVal(Bin) 
 49        Dim Ret,I
 50        Ret = 0 
 51        For I = LenB(Bin) To 1 Step -1 
 52            Ret = Ret *256 + AscB(MidB(Bin,I,1)) 
 53        Next 
 54        BinVal=Ret 
 55    End Function 
 56      
 57    Private Function BinVal2(Bin) 
 58        Dim Ret,I
 59        Ret = 0 
 60        For I = 1 To LenB(Bin) 
 61            Ret = Ret *256 + AscB(MidB(Bin,I,1)) 
 62        Next 
 63        BinVal2=Ret 
 64    End Function 
 65      
 66    Private Function GetImageSize(filespec)
 67        Dim bFlag
 68        Dim Ret(3) 
 69        ASO.LoadFromFile(filespec) 
 70        bFlag=ASO.Read(3) 
 71        Select Case Hex(binVal(bFlag)) 
 72        Case "4E5089": 
 73            ASO.Read(15) 
 74            ret(0)="PNG" 
 75            ret(1)=BinVal2(ASO.Read(2)) 
 76            ASO.Read(2) 
 77            ret(2)=BinVal2(ASO.Read(2)) 
 78        Case "464947": 
 79            ASO.read(3) 
 80            ret(0)="gif" 
 81            ret(1)=BinVal(ASO.Read(2)) 
 82            ret(2)=BinVal(ASO.Read(2)) 
 83        Case "535746": 
 84            ASO.read(5) 
 85            binData=ASO.Read(1) 
 86            sConv=Num2Str(ascb(binData),2 ,8) 
 87            nBits=Str2Num(left(sConv,5),2) 
 88            sConv=mid(sConv,6) 
 89            While(len(sConv)<nBits*4) 
 90                binData=ASO.Read(1) 
 91                sConv=sConv&Num2Str(AscB(binData),2 ,8) 
 92            Wend 
 93            ret(0)="SWF" 
 94            ret(1)=Int(Abs(Str2Num(Mid(sConv,1*nBits+1,nBits),2)-Str2Num(Mid(sConv,0*nBits+1,nBits),2))/20) 
 95            ret(2)=Int(Abs(Str2Num(Mid(sConv,3*nBits+1,nBits),2)-Str2Num(Mid(sConv,2*nBits+1,nBits),2))/20) 
 96        Case "FFD8FF": 
 97            Do  
 98            Do: p1=binVal(ASO.Read(1)): Loop While p1=255 And Not ASO.EOS 
 99            If p1>191 And p1<196 Then Exit Do Else ASO.read(binval2(ASO.Read(2))-2) 
100            Do:p1=binVal(ASO.Read(1)):Loop While p1<255 And Not ASO.EOS 
101            Loop While True 
102            ASO.Read(3) 
103            ret(0)="JPG" 
104            ret(2)=binval2(ASO.Read(2)) 
105            ret(1)=binval2(ASO.Read(2)) 
106        Case Else: 
107            If left(Bin2Str(bFlag),2)="BM" Then 
108                ASO.Read(15) 
109                ret(0)="BMP" 
110                ret(1)=binval(ASO.Read(4)) 
111                ret(2)=binval(ASO.Read(4)) 
112            Else 
113                    ret(0)="" 
114            End If 
115        End Select 
116        ret(3)="width=""" & ret(1) &""" height=""" & ret(2) &"""" 
117        getimagesize=ret 
118    End Function 
119      
120    Public Function imgW(IMGPath)
121        Dim FSO,IMGFile,FileExt,Arr
122        Set FSO = Server.CreateObject("Scripting.FileSystemObject") 
123        If (FSO.FileExists(IMGPath)) Then 
124            Set IMGFile = FSO.GetFile(IMGPath) 
125            FileExt=FSO.GetExtensionName(IMGPath) 
126            Select Case FileExt 
127                Case "gif","bmp","jpg","png": 
128                Arr=GetImageSize(IMGFile.Path) 
129                imgW = Arr(1) 
130            End Select 
131            Set IMGFile=Nothing 
132        Else
133            imgW = 0
134        End If     
135        Set FSO=Nothing 
136    End Function 
137     
138    Public Function imgH(IMGPath)
139        Dim FSO,IMGFile,FileExt,Arr
140        Set FSO = server.CreateObject("Scripting.FileSystemObject") 
141        If (FSO.FileExists(IMGPath)) Then 
142            Set IMGFile = FSO.GetFile(IMGPath) 
143            FileExt=FSO.GetExtensionName(IMGPath) 
144            Select Case FileExt 
145                Case "gif","bmp","jpg","png": 
146                Arr=getImageSize(IMGFile.Path) 
147                imgH = Arr(2) 
148            End Select 
149            Set IMGFile=Nothing 
150        Else
151            imgH = 0 
152        End If     
153        Set FSO=Nothing 
154    End Function 
155End Class
156
157IMGPath="Test.jpg"
158
159Set PP = New ImgWHInfo  
160W = PP.imgW(Server.Mappath(IMGPath))  
161H = PP.imgH(Server.Mappath(IMGPath)) 
162Set pp = Nothing 
163 
164Response.Write("<img src='"&IMGPath&"' border=0><br>宽:"&W&";高:"&H)
165%>