谁有?
我前段时间在一本书上看见过~不记得了~
实在不行就去买书了~
---------------------------------------------------------------
subnet(潇遥书生) :
不是缩略图，但可以按比例缩小，在产品列表中很实用。
1
2Class possible
3dim aso
4Private Sub Class_Initialize
5set aso=CreateObject("Adodb.Stream")
6aso.Mode=3
7aso.Type=1
8aso.Open
9End Sub
10Private Sub Class_Terminate
11set aso=nothing
12End Sub
13
14Private Function Bin2Str(Bin)
15Dim I, Str
16For I=1 to LenB(Bin)
17clow=MidB(Bin,I,1)
18if ASCB(clow)<128 then
19Str = Str & Chr(ASCB(clow))
20else
21I=I+1
22if I <= LenB(Bin) then Str = Str & Chr(ASCW(MidB(Bin,I,1)&clow))
23end if
24Next
25Bin2Str = Str
26End Function
27
28Private Function Num2Str(num,base,lens)
29dim ret
30ret = ""
31while(num>=base)
32ret = (num mod base) & ret
33num = (num - num mod base)/base
34wend
35Num2Str = right(string(lens,"0") & num & ret,lens)
36End Function
37
38Private Function Str2Num(str,base)
39dim ret
40ret = 0
41for i=1 to len(str)
42ret = ret *base + cint(mid(str,i,1))
43next
44Str2Num=ret
45End Function
46
47Private Function BinVal(bin)
48dim ret
49ret = 0
50for i = lenb(bin) to 1 step -1
51ret = ret *256 + ascb(midb(bin,i,1))
52next
53BinVal=ret
54End Function
55
56Private Function BinVal2(bin)
57dim ret
58ret = 0
59for i = 1 to lenb(bin)
60ret = ret *256 + ascb(midb(bin,i,1))
61next
62BinVal2=ret
63End Function
64
65Private Function getImageSize(filespec)
66dim ret(3)
67aso.LoadFromFile(filespec)
68bFlag=aso.read(3)
69select case hex(binVal(bFlag))
70case "4E5089":
71aso.read(15)
72ret(0)="PNG"
73ret(1)=BinVal2(aso.read(2))
74aso.read(2)
75ret(2)=BinVal2(aso.read(2))
76case "464947":
77aso.read(3)
78ret(0)="GIF"
79ret(1)=BinVal(aso.read(2))
80ret(2)=BinVal(aso.read(2))
81case "535746":
82aso.read(5)
83binData=aso.Read(1)
84sConv=Num2Str(ascb(binData),2 ,8)
85nBits=Str2Num(left(sConv,5),2)
86sConv=mid(sConv,6)
87while(len(sConv)
<nbits4) "ffd8ff":="" ,8)="" and="" aso.eos="" bindata="aso.Read(1)" case="" do="" do:="" if="" loop="" not="" p1="" ret(0)="SWF" ret(1)="int(abs(Str2Num(mid(sConv,1nBits+1,nBits),2)-Str2Num(mid(sConv,0nBits+1,nBits),2))/20)" ret(2)="int(abs(Str2Num(mid(sConv,3nBits+1,nBits),2)-Str2Num(mid(sConv,2*nBits+1,nBits),2))/20)" sconv="sConv&Num2Str(ascb(binData),2" wend="" while="">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
Function readX(pic_path)
Set fso1 = server.CreateObject("Scripting.FileSystemObject")
Set f1 = fso1.GetFile(pic_path)
ext=fso1.GetExtensionName(pic_path)
select case ext
case "gif","bmp","jpg","png":
arr=getImageSize(f1.path)
Response.Write arr(1)
case "swf"
arr=pp.getimagesize(f1.path)
Response.Write arr(1)
end select
Set f1=nothing
Set fso1=nothing
End Function
Function readY(pic_path)
Set fso1 = server.CreateObject("Scripting.FileSystemObject")
Set f1 = fso1.GetFile(pic_path)
ext=fso1.GetExtensionName(pic_path)
select case ext
case "gif","bmp","jpg","png":
arr=getImageSize(f1.path)
Response.Write arr(2)
case "swf"
arr=pp.getimagesize(f1.path)
Response.Write arr(2)
end select
Set f1=nothing
Set fso1=nothing
End Function
End Class
1
2例子：
3
4<!--#include file="picXY.asp"-->
set pp=new possible
pp.readX("E:\work\bg.jpg")
pp.readY("E:\work\bg.jpg")
1\---------------------------------------
2本来寻求无组件缩略图代码,但求得了按比例缩放的代码~勉强交差,呵呵~
3picXY.asp文件中定义的类取得了图片的宽和高,接下来按多少比例缩放应该简单了(y7967)</nbits*4)>