IDC资讯中心
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
