pixelpic.asp

. 缓存处理技术

<%






Function PixelPic(ByVal Old_Width,ByVal Old_Height,ByVal FilePath,ByVal NotImgPath)
  On Error Resume Next
  Dim Pho,New_Width,New_Height

  set Pho=new possible
  New_Width=Pho.readX(Server.MapPath(FilePath)) 
  New_Height=Pho.readY(Server.MapPath(FilePath))

  if New_Width>Old_Width then
     New_Height=New_Height * Old_Width / New_Width
     New_Width=Old_Width
  End if
  if New_Height>Old_Height then
     New_Width=New_Width * Old_Height / New_Height
     New_Height=Old_Height
  end if
  if New_width>Old_Width then New_width=Old_Width
  if New_Height>Old_Height then New_Height=Old_Height

  if Err then

     PixelPic="<img src="""& NotImgPath &""" width="""& Old_Width &""" height="""& Old_Height &""" border=""0"" alt=""无图片"">"
  else
     PixelPic="<img src="""& FilePath &""" width="""& New_Width &""" height="""& New_Height &""" border=""0"" alt="""">"
  end if
End Function





Class possible 
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 

Private 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 

Function readX(pic_path) 
  Dim fso1,f1,ext,arr
  Set fso1 = server.CreateObject("Scripting.FileSystemObject") 
  Set f1 = fso1.GetFile(pic_path) 
  ext=lcase(fso1.GetExtensionName(pic_path))

  arr=getImageSize(f1.path)








  readX=arr(1)
  Set f1=nothing 
  Set fso1=nothing 
End Function 

Function readY(pic_path) 
  Dim fso1,f1,ext,arr
  Set fso1 = server.CreateObject("Scripting.FileSystemObject") 
  Set f1 = fso1.GetFile(pic_path) 
  ext=lcase(fso1.GetExtensionName(pic_path))

  arr=getImageSize(f1.path)








  readY=arr(2)
  Set f1=nothing 
  Set fso1=nothing 
End Function 

End Class 
%>