ASP的无组件图片按比例缩放代码
此代码是ASP的无组件图片按比例缩放代码。
我从网上弄来的，规范了下代码，修改了调用函数。
代码如下：
复制内容到剪贴板 程序代码
<%
'//////////////利用ADODB.stream获取图片尺寸//////////////
Class GPS
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
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
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)
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
%>
<%
'/////获取ShowImg.asp的绝对路径/////
Dim curFile
curFile = Server.mappath(Request.servervariables("PATH_INFO"))
Dim curfilename,filename
'/////图片相对路径（存于数据库中）
curfilename = "top.gif"'rs("ImgURL")
'/////因为ShowImg.asp与images在同一目录，所以我们用instrrev获取images的路径/////
filename = left(curFile,instrrev(curFile,"\")) & curfilename
'/////建立GPS类实体/////
Dim GetPicSize
Set GetPicSize = new GPS
Set fs = Server.CreateObject("Scripting.FileSystemObject")
'/////获取图片类型/////
Dim PicSuffixName
PicSuffixName = fs.GetExtensionName(filename)
Dim PD '//Picture Dimension
Dim PWidth,PHeight
Select Case PicSuffixName
Case "gif","bmp","jpg","png":

'/////调用GPS通用类中的GetImageSize函数获取图片尺寸/////
PD = GetPicSize.GetImageSize(filename)
PWidth = PD(1) '//获取图片宽度
PHeight = PD(2) '//获取图片高度
Case "swf"
PD = GetPicSize.GetImageSize(filename)
PWidth = PD(1) '//获取Flash宽度
PHeight = PD(2) '//获取Flash高度
Case Else
End Select
Set fs = Nothing
Set GetPicSize = Nothing
%>
<%
Function imgs(w,h)

Dim PXWidth,PXHeight
Dim Pp '//Proportion
If PWidth = 0 or PWidth = "" Then
PXWidth = 0
PXHeight = 0
Else
Pp = FormatNumber(PWidth / PHeight,2) '//长宽比
End If
If PWidth >= PHeight Then
If PWidth >= w Then
PXWidth = w
PXHeight = FormatNumber(w / Pp,0)
Else
PXWidth = PWidth
PXHeight = PHeight
End If
Else
If PHeight >= h Then
PXHeight = h
PXWidth = FormatNumber(h * Pp,0)
Else
PXWidth = PWidth
PXHeight = PHeight
End If
End If
Response.Write "<img src='"&curfilename&"' border='0' width='"&PXWidth&"' height='"&PXHeight&"'>"
End Function
%>
<% Call imgs(200,100)%>
说明：更改上面ASP代码中curfilename="top.gif"处的图片路径，可以取数据库里的路径。
调用例子：Call imgs(200,100)，其中200是宽，100是高，改成你需要的即可。