ASP中取得图片宽度和高度的类(无组件)
程序员文章站
2023-11-29 18:19:28
asp中取得图片宽度和高度的类(无组件) <% class imgwhinfo '获取图片宽度和高度的类,支持jpg,gif,png,bmp &n...
asp中取得图片宽度和高度的类(无组件)
<%
class imgwhinfo '获取图片宽度和高度的类,支持jpg,gif,png,bmp
dim aso
private sub class_initialize
set aso=server.createobject("adodb.stream")
aso.mode=3
aso.type=1
aso.open
end sub
private sub class_terminate
err.clear
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)
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,i
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,i
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,i
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 bflag
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
public function imgw(imgpath)
dim fso,imgfile,fileext,arr
set fso = server.createobject("scripting.filesystemobject")
if (fso.fileexists(imgpath)) then
set imgfile = fso.getfile(imgpath)
fileext=fso.getextensionname(imgpath)
select case fileext
case "gif","bmp","jpg","png":
arr=getimagesize(imgfile.path)
imgw = arr(1)
end select
set imgfile=nothing
else
imgw = 0
end if
set fso=nothing
end function
public function imgh(imgpath)
dim fso,imgfile,fileext,arr
set fso = server.createobject("scripting.filesystemobject")
if (fso.fileexists(imgpath)) then
set imgfile = fso.getfile(imgpath)
fileext=fso.getextensionname(imgpath)
select case fileext
case "gif","bmp","jpg","png":
arr=getimagesize(imgfile.path)
imgh = arr(2)
end select
set imgfile=nothing
else
imgh = 0
end if
set fso=nothing
end function
end class
imgpath="next.gif"
set pp = new imgwhinfo
w = pp.imgw(server.mappath(imgpath))
h = pp.imgh(server.mappath(imgpath))
set pp = nothing
response.write("<img src='"&imgpath&"' border=0><br>宽:"&w&";高:"&h)
%>
<%
class imgwhinfo '获取图片宽度和高度的类,支持jpg,gif,png,bmp
dim aso
private sub class_initialize
set aso=server.createobject("adodb.stream")
aso.mode=3
aso.type=1
aso.open
end sub
private sub class_terminate
err.clear
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)
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,i
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,i
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,i
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 bflag
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
public function imgw(imgpath)
dim fso,imgfile,fileext,arr
set fso = server.createobject("scripting.filesystemobject")
if (fso.fileexists(imgpath)) then
set imgfile = fso.getfile(imgpath)
fileext=fso.getextensionname(imgpath)
select case fileext
case "gif","bmp","jpg","png":
arr=getimagesize(imgfile.path)
imgw = arr(1)
end select
set imgfile=nothing
else
imgw = 0
end if
set fso=nothing
end function
public function imgh(imgpath)
dim fso,imgfile,fileext,arr
set fso = server.createobject("scripting.filesystemobject")
if (fso.fileexists(imgpath)) then
set imgfile = fso.getfile(imgpath)
fileext=fso.getextensionname(imgpath)
select case fileext
case "gif","bmp","jpg","png":
arr=getimagesize(imgfile.path)
imgh = arr(2)
end select
set imgfile=nothing
else
imgh = 0
end if
set fso=nothing
end function
end class
imgpath="next.gif"
set pp = new imgwhinfo
w = pp.imgw(server.mappath(imgpath))
h = pp.imgh(server.mappath(imgpath))
set pp = nothing
response.write("<img src='"&imgpath&"' border=0><br>宽:"&w&";高:"&h)
%>
下一篇: ASP生成柱型体,折线图,饼图源代码