Using VBScript and Adodb.steam to get partial format image length and width

Ado|vbscript Function Bytes2bstr (VIN)
If LenB (VIN) =0 Then
Bytes2bstr = ""
Exit function
End If
' Binary conversion to string
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)
' An argument fdata, binary mapping data (as far as how to read the binary data of the image is needless to say)-_-!
' The return value is an array, 3 elements, the picture format, respectively. Long. Wide

Dim ret (2), Bflag,fsize,ados

FSIZE=CLNG (LenB (fdata)) ' Get data size

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

' Write text object reads image length width and type

ADOs. Position = 0 ' Reset data start position
Bflag = Ados.read (3)

If IsNull (bflag) Then
RET (0) = "Unknow"
RET (1) = 0
RET (2) = 0
GETIMAGEWH = RET
Exit Function
End If

' Fetch file type and long width
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
Todo
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. 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)
' Get picture binary data on the 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