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個元素,分別為圖片格式.長.寬
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
