利用ADODB.stream獲取圖片尺寸的通用類 % '//////////// GPS:Get Picture Size ////////////// '//////////////利用ADODB.stream獲取圖片尺寸////////////// '/////////Cited By Leon(心晴) 2005年8月11日////////// 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) 'GPS (2005-8-11) 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) 'GPS (2005-8-11) 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) 'GPS (2002-8-11) 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) 'GPS (2002-8-11) dim ret ret = 0 for i = 1 to lenb(bin) ret = ret *256 + ascb(midb(bin,i,1)) next BinVal2=ret End Function
'///以下是調(diào)用代碼/// Function getImageSize(filespec) 'GPS (2002-8-11) 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=sConvNum2Str(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 p1196 then exit do else aso.read(binval2(aso.Read(2))-2) do:p1=binVal(aso.Read(1)):loop while p1255 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 %>
'/////建立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": '/////調(diào)用GPS通用類中的GetImageSize函數(shù)獲取圖片尺寸///// 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
3.定義縮略圖尺寸 這部分代碼就是仁者見仁,智者見智了。首先,我們需要規(guī)定縮略圖顯示尺寸范圍,譬如:300X260,代碼可以這樣寫: % 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>=300 Then PXWidth=300 PXHeight=FormatNumber(300/Pp,0) Else PXWidth=PWidth PXHeight=PHeight End If Else If PHeight>=260 Then PXHeight=260 PXWidth=FormatNumber(260*Pp,0) Else PXWidth=PWidth PXHeight=PHeight End If End If %> 將上面的代碼緊接第二步寫下即可。調(diào)用時代碼如下: img src=%=curfilename%> border="0" width=%=PXWidth%> height=%=PXHeight%>> 至于圖片格式可以用%=PicSuffixName%>得到,圖片尺寸可以寫成 % response.write PXWidth"X"PXHeight %> 圖片大小可以用FSO.GetFileSize(filename)來實現(xiàn),而點擊次數(shù)可以簡單地用SQL語句實現(xiàn),具體編碼就不再累述了。