• Adodb.Stream取得图像的高宽


    上传图片或显示SWF的时候都希望得到它的高度和宽度

    基本原理使用Adodb.Stream读二进制文件然后进行解析,然后返回一数组
    第一个元素为类型(BMP JPG PNG GIF SWF)
    第二个元素为宽度{width}
    第三个元素为高度{height}
    第四个元素为width={width},height={height}式字符串

    Class qswhImg
     dim aso
     Private Sub Class_Initialize
      set aso=CreateObject("Adodb.Stream")
      aso.Mode=3
      aso.Type=1
      aso.Open
     End Sub
     Private Sub Class_Terminate
      set aso=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)
      'qiushuiwuhen (2002-8-12)
      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)
      'qiushuiwuhen (2002-8-12)
      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)
      'qiushuiwuhen (2002-8-12)
      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)
      'qiushuiwuhen (2002-8-12)
      dim ret
      ret = 0
      for i = 1 to lenb(bin)
       ret = ret *256 + ascb(midb(bin,i,1))
      next
      BinVal2=ret
     End Function
     
     Function getImageSize(filespec) 
      'qiushuiwuhen (2002-9-3)
      dim ret(3)
      aso.LoadFromFile(filespec)
      bFlag=aso.read(3)
      select case hex(binVal(bFlag))
      case "4E5089":
       aso.read(15)
       ret(0)="PNG"
       ret(1)=BinVal2(aso.read(2))
       aso.read(2)
       ret(2)=BinVal2(aso.read(2))
      case "464947":
       aso.read(3)
       ret(0)="GIF"
       ret(1)=BinVal(aso.read(2))
       ret(2)=BinVal(aso.read(2))
      case "535746":
       aso.read(5)
       binData=aso.Read(1)
       sConv=Num2Str(ascb(binData),2 ,8)
       nBits=Str2Num(left(sConv,5),2)
       sConv=mid(sConv,6)
       while(len(sConv)<nBits*4)
        binData=aso.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(aso.Read(1)): loop while p1=255 and not aso.EOS
        if p1>191 and p1<196 then exit do else aso.read(binval2(aso.Read(2))-2)
        do:p1=binVal(aso.Read(1)):loop while p1<255 and not aso.EOS
       loop while true
       aso.Read(3)
       ret(0)="JPG"
       ret(2)=binval2(aso.Read(2))
       ret(1)=binval2(aso.Read(2))
      case else:
       if left(Bin2Str(bFlag),2)="BM" then
        aso.Read(15)
        ret(0)="BMP"
        ret(1)=binval(aso.Read(4))
        ret(2)=binval(aso.Read(4))
       else
        ret(0)=""
       end if
      end select
      ret(3)="width=""" & ret(1) &""" height=""" & ret(2) &""""
      getimagesize=ret
     End Function
    End Class

    使用范例(读某目录下所有图片的宽度):
     set qswh=new qswhImg

     Set fso = CreateObject("Scripting.FileSystemObject")
     Set f = fso.GetFolder(server.mappath("."))
     Set fc = f.Files
     For Each f1 in fc
      ext=fso.GetExtensionName(f1.path)
      select case ext
      case "gif","bmp","jpg","png":
       arr=qswh.getImageSize(f1.path)
       response.write "<br>" & arr(0) & " " & arr(3) & ":" & f1.name & " " & arr(1) & " height:" & arr(2)
      case "swf"
       arr=qswh.getimagesize(f1.path)
       response.write "<br>" & arr(0) & " " & arr(3) & ":" & f1.name & " " & arr(1) & " height:" & arr(2)
      end select
      
     Next
     Set fc=nothing
     Set f=nothing
     Set fso=nothing
     Set qswh=nothing

    ps.其中swf部分的参考资料由蓝色提供,:p

    蓝色补充:由于 flashmx 采用了新的压缩格式 swf,所以取 flashmx 压缩格式的 swf 文件长宽并不会准确,解决办法,正在研究中。

    轉自:http://www.blueidea.com/tech/program/2003/99.asp

    申明

    非源创博文中的内容均收集自网上,若有侵权之处,请及时联络,我会在第一时间内删除.再次说声抱歉!!!

    博文欢迎转载,但请给出原文连接。

  • 相关阅读:
    设计模式之原型模式
    【转载】 吵翻了!这张图里到底是人还是狗?心理学家这样说
    【转载】 DeepMind 提出元梯度强化学习算法,显著提高大规模深度强化学习应用的性能
    ubuntu18.04 安装wine64出现错误: X 64-bit development files not found.
    ubuntu18.04 源码方式安装wine , 警告,libxrender 64-bit development files not found, XRender won't be supported.
    【转载】 信息如何像零食、金钱一样掌控你的大脑
    图像处理算法 之 滤波 模糊(基于OpenCV)
    图像处理之FPN校正
    ISP-黑电平校正(BLC)
    ISP基础(0y):图像传感器
  • 原文地址:https://www.cnblogs.com/Athrun/p/1353624.html
Copyright © 2020-2023  润新知