浏览文件夹下面所有图片
复制代码 代码如下:<% '+-----------------------------------+ '| 变量设置 '+-----------------------------------+ 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 "[ 上一页 ] " response.Write "<< " i = pageStart Do while i < page response.Write "[" & i & "] " i = i + 1 Loop response.Write "[" & page & "]" i = pageMiddle Do while i <= pageEnd response.Write "[" & i & "] " i = i + 1 Loop response.Write "...[" & pageTotal & "]" response.Write " >>" response.Write "[ 下一页 ] 共 " & pageTotal & " 页 当前所在第 " & page & " 页 图片数 : " & picTotal & "" 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)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 = Server.CreateObject("Scripting.FileSystemObject") Set folderObj = fileObj.GetFolder(server.MapPath("."&pic_path)) i = 0 For Each file in folderObj.Files If isPIC(file.Name, cPicType) Then fileArray(i) = file.Name i = i + 1 reDim Preserve fileArray(i) End If Next Set FileObj = Nothing Set FolderObj = Nothing picTotal = UBound(fileArray) '+-----------------------------------+ '| 分页处理 '+-----------------------------------+ page = int(Request.QueryString("page")) pageTotal = -(int(-(picTotal/cEachPageMax))) If page = Empty or page < 0 Then page = 1 If page > pageTotal Then page = pageTotal offset = cEachPageMax * page start = offset - cEachPageMax If start < 0 Then start = 0 If offset > picTotal Then offset = picTotal pageStart = page - cEachPageMax If pageStart <= 0 Then pageStart = 1 pageMiddle = page + 1 pageEnd = pageMiddle + cEachPageMax If page <= cEachPageMax Then pageEnd = cEachPageMax * 2 If pageEnd > pageTotal Then pageEnd = pageTotal '+-----------------------------------+ '| 输出部分 '+-----------------------------------+ %> <%=cTitle%>
<%=cTitle%>
<% pageBar page, pageTotal %>
<% '+-----------------------------------+ '| 循环输出图片 '+-----------------------------------+ j = 1 i = start Set pp = New possible Do While i < offset thisPicPath = server.mappath("."&pic_path & fileArray(i)) x = pp.readX(thisPicPath) y = pp.readY(thisPicPath) If x > cWidth or y > cHeight Then tWidth = x / cWidth : tHeight = y / cHeight If tWidth > tHeight Then w = cWidth h = y / tWidth Elseif tWidth < tHeight Then h = cHeight w = x / tHeight Else w = cWidth h = cHeight End If Else w = x h = y End If If j > cEachLineMax Then j = 1 response.Write "