利用VBScript及ADODB.Steam擷取部分格式圖象長寬

來源:互聯網
上載者:User
ado|vbscript 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


相關文章

E-Commerce Solutions

Leverage the same tools powering the Alibaba Ecosystem

Learn more >

Apsara Conference 2019

The Rise of Data Intelligence, September 25th - 27th, Hangzhou, China

Learn more >

Alibaba Cloud Free Trial

Learn and experience the power of Alibaba Cloud with a free trial worth $300-1200 USD

Learn more >

聯繫我們

該頁面正文內容均來源於網絡整理,並不代表阿里雲官方的觀點,該頁面所提到的產品和服務也與阿里云無關,如果該頁面內容對您造成了困擾,歡迎寫郵件給我們,收到郵件我們將在5個工作日內處理。

如果您發現本社區中有涉嫌抄襲的內容,歡迎發送郵件至: info-contact@alibabacloud.com 進行舉報並提供相關證據,工作人員會在 5 個工作天內聯絡您,一經查實,本站將立刻刪除涉嫌侵權內容。