<%

'odb.Stream 对象 读取图片长度和宽度

'上传图片或显示SWF的时候都希望得到它的高度和宽度

'
'基本原理使用Adodb.Stream读二进制文件然后进行解析，然后返回一数组
'第一个元素为类型(BMP JPG PNG GIF SWF)
'第二个元素为宽度{width}
'第三个元素为高度{height}
'第四个元素为width={width},height={height}式字符串

Class GL_Img

 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
   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) &""""
  getp_w_picpathsize=ret
 End Function
End Class

 

'使用范例（读某目录下所有图片的宽度）：

Set GL=new GL_Img

Set FSO=CreateObject("Scripting.FileSystemObject")

Set F=FSO.GetFolder(Server.Mappath("../p_w_picpaths/"))
Set FC=F.Files

For Each f1 In FC

 ext=FSO.GetExtensionName(f1.path)
 Select Case LCase(ext)
 Case "gif","bmp","jpg","png":
  arr=GL.getImageSize(f1.path)
  Response.Write "<br>" & arr(0) & " " & arr(3) & ":" & f1.Name & " width:" & arr(1) & " height:" & arr(2)
 Case "swf"
  arr=GL.getp_w_picpathsize(f1.path)
  Response.Write "<br>" & arr(0) & " " & arr(3) & ":" & f1.Name & " width:" & arr(1) & " height:" & arr(2)
 End Select
Next

Set FC=Nothing

Set F=Nothing
Set FSO=Nothing
Set GL=Nothing
%>

 

参考：