浏览文件夹下面所有图片

答案：
[复制此代码]CODE:

<% 
'+-----------------------------------+ 
'|     变量设置 
'+-----------------------------------+ 
cTitle =   "所有上传图片(注:以下为图片文件夹下面所有图片，并非全部为有效图片!)"   '名字 
cPicType =   "jpeg,jpg,gif,png,bmp"   '图片类型   (使用","将图片格式分开) 
cHeight =   120   '缩图高度 
cWidth =   120   '缩图宽度 
cEachLineMax =   5 '每行显示图片数 
cEachPageMax =   20   '每页显示图片数目 
pic_path="/uploadpic/" '设定图片所在路径 
'+-----------------------------------+ 
'|     定义函数 
'+-----------------------------------+ 
Function   getExt(name) 
getExt   =   right(name,   3) 
End   Function 
Function   isPIC(fileName,   picType) 
ext   =   getExt(fileName) 
isPIC   =   False 
typeList   =   split(picType,   ",") 
For   ii   =   LBound(typeList)   To   UBound(typeList) 
If   UCase(ext)   =   UCase(typeList(ii))   Then 
isPIC   =   True 
Exit   For 
End   If 
Next 
End   Function 
Function   pageBar(page,   pageTotal) 
response.Write   "[   <A   HREF=>response.Write   "<A   HREF=>i   =   pageStart 
Do   while   i   <   page 
response.Write   "<A   HREF=>i   =   i   +   1 
Loop 
response.Write   "[<FONT   COLOR=red><B>"   &   page   &   "</B></FONT>]" 
i   =   pageMiddle 
Do   while   i   <=   pageEnd 
response.Write   "<A   HREF=>i   =   i   +   1 
Loop 
response.Write   "...<A   HREF=>response.Write   "   <A   HREF=>response.Write   "[   <A   HREF=>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   K,   Str 
    For   K=1   to   LenB(Bin) 
      clow=MidB(Bin,K,1) 
      if   ASCB(clow)<128   then 
        Str   =   Str   &   Chr(ASCB(clow)) 
      else 
        K=K+1 
        if   K   <=   LenB(Bin)   then   Str   =   Str   &   Chr(ASCW(MidB(Bin,K,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   k=1   to   len(str) 
      ret   =   ret   *base   +   cint(mid(str,k,1)) 
    next 
    Str2Num=ret 
  End   Function 
  Private   Function   BinVal(bin) 
    dim   ret 
    ret   =   0 
    for   k   =   lenb(bin)   to   1   step   -1 
      ret   =   ret   *256   +   ascb(midb(bin,k,1)) 
    next 
    BinVal=ret 
  End   Function 
  Private   Function   BinVal2(bin) 
    dim   ret 
    ret   =   0 
    for   k   =   1   to   lenb(bin) 
      ret   =   ret   *256   +   ascb(midb(bin,k,1)) 
    next 
    BinVal2=ret 
  End   Function 
  Private   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  
Function   readX(pic_path) 
      Set   fso1   =   server.CreateObject("Scripting.FileSystemObject") 
      Set   f1   =   fso1.GetFile(pic_path) 
      ext=fso1.GetExtensionName("."&pic_path) 
      select   case   UCase(ext) 
          case   "GIF","BMP","JPG","PNG": 
        arr=getImageSize(f1.path) 
        readX   =   arr(1) 
          case   "swf" 
        arr=pp.getimagesize(f1.path) 
        readX   =   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   UCase(ext) 
          case   "GIF","BMP","JPG","PNG": 
        arr=getImageSize(f1.path) 
        readY   =   arr(2) 
          case   "swf" 
        arr=pp.getimagesize(f1.path) 
        readY   =   arr(2) 
      end   select 
      Set   f1=nothing 
      Set   fso1=nothing 
  End   Function 
End   Class 
'+-----------------------------------+ 
'|     数据处理 
'+-----------------------------------+ 
Dim   fileArray() 
reDim   fileArray(0) 
Set   fileObj =

上一个：支持加号空格的查询
下一个：asp数据库防下载处理