ASP获取图片的高度和宽度

<%
Class Image
    Private oStream
    Public ImgW,ImgH
    
    Private Sub Class_Initialize
        Set oStream=CreateObject("Adodb.Stream")
        oStream.Mode=3
        oStream.Type=1
        oStream.Open
    End Sub
    
    Private Sub Class_Terminate
        Set oStream=nothing
    End Sub

    Private Function Bin2Str(Bin)
        Dim I, Str
        For I=1 to LenB(Bin)
            clow=MidB(Bin,I,1)
            If ASCB(clow)<128 then
                Str = Str & Chr(ASCB(clow))
            Else
                I=I+1
                If I <= LenB(Bin) then Str = Str & Chr(ASCW(MidB(Bin,I,1)&clow))
            End If
        Next
        Bin2Str = Str
    End Function

    Private Function Num2Str(num,base,lens)
        Dim ret
        ret = ""
        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(str,base)
        Dim ret
        ret = 0
        For i=1 to len(str)
            ret = ret *base + cint(mid(str,i,1))
        Next
        Str2Num=ret
    End Function

    Private Function BinVal(bin)
        Dim ret
        ret = 0
        For i = lenb(bin) to 1 step -1
            ret = ret *256 + ascb(midb(bin,i,1))
        Next
        BinVal=ret
    End Function

    Private Function BinVal2(bin)
        Dim ret
        ret = 0
        For i = 1 to lenb(bin)
            ret = ret *256 + ascb(midb(bin,i,1))
        Next
        BinVal2=ret
    End Function

    Private Function getImageSize(filespec)
        dim ret(3)
        oStream.LoadFromFile(filespec)
        bFlag=oStream.read(3)
        Select Case hex(binVal(bFlag))
            Case "4E5089":
                oStream.read(15)
                ret(0)="PNG"
                ret(1)=BinVal2(oStream.read(2))
                oStream.read(2)
                ret(2)=BinVal2(oStream.read(2))
            Case "464947":
                oStream.read(3)
                ret(0)="GIF"
                ret(1)=BinVal(oStream.read(2))
                ret(2)=BinVal(oStream.read(2))
            Case "535746":
                oStream.read(5)
                binData=oStream.Read(1)
                sConv=Num2Str(ascb(binData),2 ,8)
                nBits=Str2Num(left(sConv,5),2)
                sConv=mid(sConv,6)
                while(len(sConv)<nBits*4)
                    binData=oStream.Read(1)
                    sConv=sConv&Num2Str(ascb(binData),2 ,8)
                wend
                ret(0)="SWF"
                ret(1)=int(abs(Str2Num(mid(sConv,1*nBits+1,nBits),2)-Str2Num(mid(sConv,0*nBits+1,nBits),2))/20)
                ret(2)=int(abs(Str2Num(mid(sConv,3*nBits+1,nBits),2)-Str2Num(mid(sConv,2*nBits+1,nBits),2))/20)
            Case "FFD8FF":
                do
                    do: p1=binVal(oStream.Read(1)): loop while p1=255 and not oStream.EOS
                    If p1>191 and p1<196 then exit do Else oStream.read(binval2(oStream.Read(2))-2)
                    do:p1=binVal(oStream.Read(1)):loop while p1<255 and not oStream.EOS
                loop while true
                oStream.Read(3)
                ret(0)="JPG"
                ret(2)=binval2(oStream.Read(2))
                ret(1)=binval2(oStream.Read(2))
            Case Else:
                If left(Bin2Str(bFlag),2)="BM" then
                    oStream.Read(15)
                    ret(0)="BMP"
                    ret(1)=binval(oStream.Read(4))
                    ret(2)=binval(oStream.Read(4))
                Else
                    ret(0)=""
                End If
        End Select
        ret(3)="width=""" & ret(1) &""" height=""" & ret(2) &""""
        getimagesize=ret
    End Function
    
    Public Sub getWH(pic_path)
        Set oFso = server.CreateObject("Scripting.FileSystemObject")
        Set oFile = oFso.GetFile(pic_path)
        Ext=oFso.GetExtensionName(pic_path)
        If Ext="gif" or Ext="bmp" or Ext="jpg" or Ext="png" Then
            arr=getImageSize(oFile.path)
            ImgW=arr(1)
            ImgH=arr(2)
        End If
        Set oFile=nothing
        Set oFso=nothing
    End Sub
End Class

'使用:
'Set oImage=new Image
'Call oImage.getWH(Server.MapPath("mzwu.com.jpg"))
'Response.Write(oImage.ImgW & "<br/>" & oImage.ImgH)
%>


评论: 0 | 引用: 0 | 查看次数: 7206
发表评论
登录后再发表评论!