《拓文asp.net网站内容管理系统》官方演示站。
 设为首页  
 收藏本站
 作者:黄振安
 QQ:53854651
首 页 开源拓文.NET编程网站编程网页设计图形图像数据库软件工程留言本
    站内搜索:  
您现在的位置: 拓文网络 → 网站编程 → ASP → 上传图片或显示SWF的时候都希望得到它的高度和宽度[正文]

热 门 文 章

相 关 文 章
  • ASP.NET性能优化
  • ASP脚本循环语句
  • 在.NET框架应用程序中发送电子邮件
  • .net打包自动安装数据库
  • asp.net开发wap必备:更好的匹配手机设备
  • 用ashx动态生成文件
  • windows 2003下asp.Net站点无法使用用户名+密码的方
  • ASP.NET中17种正则表达式
  • 提高ASP.Net应用程序性能的十大方法
  • 一个通过web.Mail发送邮件的类
  • 上传图片或显示SWF的时候都希望得到它的高度和宽度
     
    [作者:不详    转贴自:不详    点击数:    更新时间:2006-3-14 9:18:18]

    基本原理使用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 & " width:" & arr(1) & " height:" & arr(2)
    case "swf"
    arr=qswh.getimagesize(f1.path)
    response.write "<br/>" & arr(0) & " " & arr(3) & ":" & f1.name & " width:" & arr(1) & " height:" & arr(2)
    end select

    Next
    Set fc=nothing
    Set f=nothing
    Set fso=nothing
    Set qswh=nothing


    首页 | 1 | 尾页  共 1 页
     
    hch004 打印本页 关闭窗口

         文 章 评 论
    评论人 查看该文章的评论 发表时间
       笔 名* : 0 50分 60分 70分 80分 90分 100分
    评论内容 *: (最多1000字。当前字数:0)


    没有相关评论,欢迎您参与!

    - 关于本站 - 网站帮助 - 下载声明 - 友情连接 - 网站地图 -
    Copyright © 2005-2006 myTopWin.Com. All Rights Reserved . [桂ICP备06004496号]