ASP中取得图片宽度和高度

来源:asp之家 时间:2009-11-08 18:39:00 

基本原理使用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

标签:图片,宽度,高度,asp
0
投稿

猜你喜欢

  • XML入门的常见问题(一)

    2008-09-05 17:20:00
  • ext3下删除mysql数据库的数据恢复案例

    2009-05-13 14:39:00
  • UCDChina.com 关于用户期望的讨论

    2008-07-10 11:55:00
  • Sql Server 和 Access 操作数据库结构Sql语句

    2008-02-11 18:59:00
  • 解决SQLServer最大流水号的两个好方法

    2009-01-13 14:15:00
  • 百度在线手写输入法

    2010-02-03 14:27:00
  • HTML 5 正在改变 Web

    2008-09-15 08:20:00
  • 经典的退出浏览器弹窗代码

    2008-07-30 12:48:00
  • 三种SQL分页查询的存储过程代码

    2012-01-05 19:31:32
  • ASP强制刷新和判断文件地址是否存在

    2007-09-16 17:11:00
  • When we`re only No.2, we try harder之淘宝节日LOGO互动设计小探讨

    2010-01-20 10:31:00
  • javascript 模拟函数指针

    2009-09-19 18:02:00
  • 用ASP木马实现FTP和解压缩

    2008-02-13 08:47:00
  • ip地址和身份证的js验证代码

    2007-12-29 21:49:00
  • 通过T-SQL语句实现数据库备份与还原的代码

    2011-12-01 08:02:15
  • 任意定制文本对齐方式:CSS Text Wrapper

    2008-02-03 11:11:00
  • ASP平台如何打造金牌英文网站

    2008-04-10 08:47:00
  • 细化解析:MySQL 数据库中对XA事务的限制

    2009-01-14 11:59:00
  • MySQL数据库对dvbbs.php全文搜索的完全分析

    2010-06-11 13:25:00
  • 全兼容可高亮二级缓冲折叠菜单

    2010-06-03 16:53:00
  • asp之家 网络编程 m.aspxhome.com