利用VB&#083;cript及ADODB.Steam获取部分格式图象长宽

2024-07-21 02:24:01

字体：大中小

来源：转载

供稿：网友

function bytes2bstr(vin)
if lenb(vin) =0 then
bytes2bstr = ""
exit function
end if
''二进制转换为字符串
dim bytesstream,stringreturn
set bytesstream = server.createobject("adodb.stream")
bytesstream.type = 2
bytesstream.open
bytesstream.writetext vin
bytesstream.position = 0
bytesstream.charset = "gb2312"
bytesstream.position = 2
stringreturn = bytesstream.readtext
bytesstream.close
set bytesstream = nothing
bytes2bstr = stringreturn
end function

function binval(bin)
dim i
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

function binval2(bin)
dim i
dim ret:ret = 0
for i = 1 to lenb(bin)
ret = ret *256 + ascb(midb(bin,i,1))
next
binval2 = ret
end function

function getimagewh(fdata)
'一个实参fdata,二进制图象数据(至于怎么读取图象的二进制数据就不用说了吧-_-!)
'返回值为一个数组,3个元素,分别为图片格式.长.宽

dim ret(2),bflag,fsize,ados

fsize=clng(lenb(fdata)) '取得数据尺寸

if fsize=0 then exit function

set ados = server.createobject("adodb.stream")
ados.type = 1
ados.mode = 3
ados.open

ados.write fdata
ados.position = 0

'写文本对象读取图像长宽和类型

ados.position = 0 '重置数据开始位置
bflag = ados.read(3)

if isnull(bflag) then
ret(0) = "unknow"
ret(1) = 0
ret(2) = 0
getimagewh = ret
exit function
end if

'取文件类型和长宽
select case hex(binval(bflag))
case "4e5089":
ados.read(15)
ret(0) = "png"
ret(1) = binval2(ados.read(2))
ados.read(2)
ret(2) = binval2(ados.read(2))
case "464947":
ados.read(3)
ret(0) = "gif"
ret(1) = binval(ados.read(2))
ret(2) = binval(ados.read(2))
case "ffd8ff":
dim p1
do
do: p1 = binval(ados.read(1)): loop while p1 = 255 and not ados.eos
if p1 > 191 and p1 < 196 then exit do else ados.read(binval2(ados.read(2))-2)
do:p1 = binval(ados.read(1)):loop while p1 < 255 and not ados.eos
loop while true
ados.read(3)
ret(0) = "jpg"
ret(2) = binval2(ados.read(2))
ret(1) = binval2(ados.read(2))
case else:
if left(bytes2bstr(bflag),2) = "bm" then
ados.read(15)
ret(0) = "bmp"
ret(1) = binval(ados.read(4))
ret(2) = binval(ados.read(4))
else
ret(0) = ""
end if
ados.close
set ados = nothing
end select

select case ret(0)
case "png","jpg","bmp","gif"
ret(1) = ret(1)
ret(2) = ret(2)
ret(0) = ret(0)
case else
ret(1) = 0
ret(2) = 0
ret(0) = "unknow"
end select

getimagewh = ret
end function

function getwebdata(strurl)
'获取internet上的图片二进制数据
on error resume next
if strurl="" then
getwebdata = ""
exit function
end if
dim tempstr
tempstr=split(strurl,"/")
if tempstr(ubound(tempstr))="" or instr(strurl,"/")=0 then
getwebdata = ""
exit function
end if

dim retrieval
set retrieval = server.createobject("microsoft.xmlhttp")
with retrieval
.open "get", strurl, false, "", ""
.send
getwebdata =.responsebody
end with
set retrieval = nothing
if err.number <> 0 then err.clear

end function

最大的网站源码资源下载站，

上一篇：水晶报表打印单据时增加空行或空白行的示例脚本

下一篇：c#中使用 crystal reports (水晶报表)的打包和部署问题