<%
Class qswhimg
Dim Aso
Private sub class_initialize
Set Aso = Createobject ("ADODB. Stream ")
Aso. mode = 3
Aso. type = 1
Aso. Open
End sub
Private sub class_terminate
Set Aso = nothing
End sub
Private function bin2str (BIN)
Dim I, STR
For I = 1 to lenb (BIN)
Clow = midb (bin, I, 1)
If ASCB (Clow) <128 then
STR = STR & CHR (ASCB (Clow ))
Else
I = I + 1
If I <= lenb (BIN) then STR = STR & CHR (ASCW (midb (bin, I, 1) & Clow ))
End if
Next
Bin2str = Str
End Function
Private function num2str (Num, base, lens)
Dim RET
Ret = ""
While (Num> = Base)
Ret = (Num mod base) & RET
Num = (num-num mod base)/base
Wend
Num2str = right (string (lens, "0") & num & ret, lens)
End Function
Private function str2num (STR, Base)
Dim RET
Ret = 0
For I = 1 to Len (STR)
Ret = RET * base + CINT (mid (STR, I, 1 ))
Next
Str2num = RET
End Function
Private function binval (BIN)
Dim ret, I
Ret = 0
For I = lenb (BIN) to 1 step-1
Ret = RET * 256 + ASCB (midb (bin, I, 1 ))
Next
Binval = RET
End Function
Private function binval2 (BIN)
Dim ret, I
Ret = 0
For I = 1 to lenb (BIN)
Ret = RET * 256 + ASCB (midb (bin, I, 1 ))
Next
Binval2 = RET
End Function
Function getimagesize (filespec)
Dim RET (3), bflag, p1
Aso. loadfromfile (filespec)
Bflag = ASO. Read (3)
Select case hex (binval (bflag ))
Case "4e5089 ":
Aso. Read (15)
RET (0) = "PNG"
RET (1) = binval2 (ASO. Read (2 ))
Aso. Read (2)
RET (2) = binval2 (ASO. Read (2 ))
Case "464947 ":
Aso. Read (3)
RET (0) = "GIF"
RET (1) = binval (ASO. Read (2 ))
RET (2) = binval (ASO. Read (2 ))
Case "535746 ":
Aso. Read (5)
Bindata = ASO. Read (1)
Sconv = num2str (ASCB (bindata), 2, 8)
Nbits = str2num (left (sconv, 5), 2)
Sconv = mid (sconv, 6)
While (LEN (sconv) <nbits * 4)
Bindata = ASO. Read (1)
Sconv = sconv & num2str (ASCB (bindata), 2, 8)
Wend
RET (0) = "SWF"
RET (1) = int (ABS (str2num (mid (sconv, 1 * nbits + 1, nbits), 2)-str2num (mid (sconv, 0 * nbits + 1, nbits), 2)/20)
RET (2) = int (ABS (str2num (mid (sconv, 3 * nbits + 1, nbits), 2)-str2num (mid (sconv, 2 * nbits + 1, nbits), 2)/20)
Case "ffd8ff ":
Do
Do: p1 = binval (ASO. Read (1): loop while p1 = 255 and not ASO. Eos
If P1> 191 and P1 <196 then exit do else ASO. Read (binval2 (ASO. Read (2)-2)
Do: p1 = binval (ASO. Read (1): loop while P1 <255 and not ASO. Eos
Loop while true
Aso. Read (3)
RET (0) = "jpg"
RET (2) = binval2 (ASO. Read (2 ))
RET (1) = binval2 (ASO. Read (2 ))
Case else:
If left (bin2str (bflag), 2) = "BM" then
Aso. Read (15)
RET (0) = "BMP"
RET (1) = binval (ASO. Read (4 ))
RET (2) = binval (ASO. Read (4 ))
Else
RET (0) = ""
End if
End select
RET (3) = "width =" & RET (1) & "" Height = "& RET (2 )&""""
Getimagesize = RET
End Function
End Class
%>
// Call
<%
PIC = RS ("p_pictureurlb ")
If PIC = "" then
PIC = "upfile/2008000883698888.jpg"
End if
Dim qswh, arr
Set qswh = new qswhimg
Arr = qswh. getimagesize (server. mappath (PIC ))
Width = Arr (1)
Height = Arr (2)
Set arr = nothing
Set qswh = nothing
%>