📄 lbbs_pic.asp
字号:
End sub
'========================================
'========================================
'遍历站点所有文件存入数组
'i序数
'path文件夹路径
function bianlifile(i,path)
Dim path2,fi,GetFiles,objFolder,FileExt,fi_Name,fi_time,fi_Size,fi_path
path2=Server.MapPath(path)
on error resume next
set objFolder=fso.GetFolder(path2)
for each fi in objFolder.files
FileExt = fso.GetExtensionName(fi.Name) '获得文件的扩展名
if FileExt<>"" then
FileExt = Lcase(FileExt)
end If
If ((instr(LCase(c_PicType),FileExt)>0 And instr(LCase(fi.Name),"_[small]")=0) Or (instr(LCase(c_TxtType),FileExt)>0) And Session("lbbs_pic_show")<>"smallpic") and instr(LCase(fi.name),search_key)>0 Then
If c_PicPaixutime="CR" Then
fi_time= fi_time & fi.DateCreated&"|" '建立日期
elseIf c_PicPaixutime="LM" Then
fi_time= fi_time & fi.DateLastModified&"|" '最近一次修改日期与时间
End if
fi_Name= fi_Name & fi.Name&"|" '文件名
fi_Size = fi_Size & fi.Size &"|" '文件大小
fi_path = fi_path & path&"|" '文件路径
i = i + 1
End if
Next
If c_showallpic="ALL" or search_path<>"" Then '选择显示所有目录图片时递归读取子目录图片
for each fi in objFolder.Subfolders
call bianlifile(i,path & "/" & fi.name)'递归
Next
End if
set objFolder=Nothing
Session("fi_Name")=Session("fi_Name") & fi_Name
Session("fi_time")=Session("fi_time") & fi_time
Session("fi_Size")=Session("fi_Size") & fi_Size
Session("fi_path")=Session("fi_path") & fi_path
end function
'========================================
'图片列表
'path－图片当前目录
'showpage-显示上下一页的链接（YES：显示，NO：不显示）
'number-图片数
sub main(path,showpage,number)
Dim theFile_small,theFiletosmall,theFile_time,theFile_name,theFile_size,theFile_path
dim c,GetFiles,f,one,two,TempName,TempTime,TempSize,j,k,Temppath
Dim orderByConditions,FileArr(),i,p,Max,OrderBy,Total,PageStart,PageEnd
Dim PCount,PFSize,APFSize,fsoFolder,FilterName
'页码
picPage=trim(request("page"))
if picPage<>"" then
picPage=cint(picPage)
else
picPage=1
end If
If c_showallpic<>"ALL" Or (c_showallpic="ALL" and path=c_UploadDirg and c_homeshowpic="ONE") Then
'得到当前目录下所有文件的信息集合
set fsoFolder=fso.GetFolder(Server.MapPath(path))
Set GetFiles =fsoFolder.files
'定义了文件总数的数组(0为文件名,1为日期时间,2为文件大小)
ReDim FileArr(Getfiles.count-1,3)
i = 0
For Each f In GetFiles
FileExt = fso.GetExtensionName(f.Name) '获得文件的扩展名
if FileExt<>"" then
FileExt = Lcase(FileExt)
end If
If ((instr(LCase(c_PicType),FileExt)>0 And instr(LCase(f.Name),"_[small]")=0) Or (instr(LCase(c_TxtType),FileExt)>0) And Session("lbbs_pic_show")<>"smallpic") and instr(LCase(f.name),search_key)>0 Then
FileArr(i,0) = f.Name '文件名
If c_PicPaixutime="CR" Then
FileArr(i,1) = f.DateCreated '建立日期
elseIf c_PicPaixutime="LM" Then
FileArr(i,1) = f.DateLastModified '最近一次修改日期与时间
End if
FileArr(i,2) = f.Size '文件大小
FileArr(i,3) = path '文件路径
APFSize=APFSize+f.Size '文件总大小
i = i + 1
End If
Next
If i<1 Then
response.write " <font color='#FF9900'>当前目录无符合条件的文件。</font>"
Exit Sub '如果无文件则退出过程，以免后面的数组读取出错
End If
set fsoFolder=Nothing
set GetFiles=Nothing
Total=i
Else
'遍历站点所有文件（当前目录下及子目录所有文件）的信息集合
call bianlifile(0,path) '遍历站点所有文件
Dim fi_NameArr,fi_timeArr,fi_SizeArr,fi_pathArr,fi_count,q
fi_NameArr = split(Session("fi_Name"),"|")
fi_timeArr = split(Session("fi_time"),"|")
fi_SizeArr = split(Session("fi_Size"),"|")
fi_pathArr = split(Session("fi_path"),"|")
fi_count = ubound(fi_NameArr)
If fi_count<1 Then
response.write " <font color='#FF9900'>当前目录无符合条件的文件。</font>"
Exit Sub '如果无文件则退出过程，以免后面的数组读取出错
End If
APFSize=0
ReDim FileArr(fi_count-1,3)
for q = 0 to fi_count-1
FileArr(q,0)=fi_NameArr(q)
FileArr(q,1)=fi_timeArr(q)
FileArr(q,2)=fi_SizeArr(q)
FileArr(q,3)=fi_pathArr(q)
APFSize=APFSize+fi_SizeArr(q)
Next
Total=fi_count
Session("fi_Name")=""
Session("fi_time")=""
Session("fi_Size")=""
Session("fi_path")=""
end If
'对文件进行排序按日期，OrderBy等于DESC降序，OrderBy等于ASC升序
Dim FileArrOne,FileArrTwo
If c_PicPaixu="TIME" Or c_PicPaixu="SIZE" then
For One = 0 To Total - 1
For Two = 0 To Total - 1
If c_PicPaixu="TIME" then
FileArrOne=FileArr(One,1)
FileArrTwo=FileArr(Two,1)
ElseIf c_PicPaixu="SIZE" then
FileArrOne=FileArr(One,2)
FileArrTwo=FileArr(Two,2)
End if
IF Ucase(c_orderBy) = "DESC" Then
orderByConditions=(FileArrOne > FileArrTwo)
ElseIF Ucase(c_orderBy) = "ASC" Then
orderByConditions=(FileArrOne < FileArrTwo)
End If
IF orderByConditions Then
TempName = FileArr(Two,0)
TempTime = FileArr(Two,1)
TempSize = FileArr(Two,2)
Temppath = FileArr(Two,3)
FileArr(Two,0) = FileArr(One,0)
FileArr(Two,1) = FileArr(One,1)
FileArr(Two,2) = FileArr(One,2)
FileArr(Two,3) = FileArr(One,3)
FileArr(One,0) = TempName
FileArr(One,1) = TempTime
FileArr(One,2) = TempSize
FileArr(One,3) = Temppath
End IF
Next
Next
End if
'得到总页数
IF Total Mod number = 0 Then
PCount = ToTal / number
Else
PCount = Total \ number + 1
End IF
IF picpage > PCount Then picpage = PCount
'得到当前页的文件位置,开始地址如果为第一页则其实位置是0，因为数组的下限是0
PageStart = picpage * number - number
IF (Total-1-number) > PageStart Then
PageEnd=PageStart+number-1
Else
PageEnd=(Total-1)
End If
'显示列表
%>
<form name="myform" method="Post" action="?forder=<%=forder%>&page=<%=picPage%>" onsubmit="return confirm('你确定要执行操作吗？');">
<div align="left">
<table border="0" cellspacing="3" style="border-color: #FF0000;">
<tr class="tdbg">
<%
PFSize = 0
FileCount=0
For j = PageStart To PageEnd
If forder=c_UploadDirg And c_showallpic="ALL" And c_homeshowpic="FENLEI" And Session("lbbs_pic_show")="" And j=number Then
Exit for '首页各文件夹图片列表中止
End If
theFile_Name = FileArr(j,0)
theFile_time = FileArr(j,1)
theFile_size = clng(FileArr(j,2))
theFile_path = FileArr(j,3)
FileExt=lcase(mid(theFile_Name,instrrev(theFile_Name,".")+1)) '获得文件的扩展名
If Session("lbbs_pic_show")="delpic" Then '点击“删除图片”时背景色样式
picbgclass="pic_delstyle"
Elseif Session("lbbs_pic_show")="smallpic" Then '点击“生成缩图”时背景色样式
picbgclass="pic_smallstyle"
Elseif Session("lbbs_pic_show")="delsmallpic" Then '点击“删除缩图”时背景色样式
picbgclass="pic_delsmallstyle"
Else
picbgclass="pic_showstyle"
end if
If ((instr(LCase(c_PicType),FileExt)>0 And instr(LCase(theFile_Name),"_[small]")=0) Or (instr(LCase(c_TxtType),FileExt)>0) And Session("lbbs_pic_show")<>"smallpic") and instr(LCase(theFile_Name),search_key)>0 Then
%>
<td valign="top">
<table cellPadding="3" border="0" width="<%=c_picwidth+12%>" cellpadding="0" style="word-break:break-all;">
<tr>
<td align="center" height="<%=c_picheight+12%>" class="<%=picbgclass%>">
<%
If instr(LCase(c_PicType),FileExt)>0 Then
theFile_small=Replace(theFile_Name,Right(theFile_Name,4),"_[small]"& Right(theFile_Name,4)) '缩略图
If fso.FileExists(Server.Mappath(theFile_path &"\"&theFile_small))=true Then '检查缩略图是否存在
theFile_small=theFile_small
theFiletosmall=True
Else
theFile_small=theFile_Name
theFiletosmall=false
End If
response.write "<a href='"&URLEncode(theFile_path&"/"&theFile_Name)&"' target='_blank'><img src='"&URLEncode(theFile_path&"/"&theFile_small)&"' alt='[文件] "&theFile_Name&Chr(10)&"[时间] "&theFile_time&Chr(10)&"[大小] "&SizeTo(theFile_size)&"' border='0' onmouseover=""this.style.cursor='hand';"" onload='javascript:DrawImage(this);' width="&c_picwidth&" height="&c_picheight&"></a>"
ElseIf instr(LCase(c_TxtType),FileExt)>0 and Session("lbbs_pic_show")<>"smallpic" Then
response.write "<p align='left'><a href='"&URLEncode(theFile_path&"/"&theFile_Name)&"' target='_blank'><img src='images/" & FileExt & ".gif' border='0' onmouseover=""this.style.cursor='hand';"" class='imgmid' onerror=""this.src='images/noknow.gif';""><font style='font-size: 11pt;'>"&theFile_Name&"</font></a>"
End if
%>
</td>
</tr>
<tr>
<td align="left">
<%
If c_shownane="YES" Then'显示图片文件名
response.write "<font color='#0066FF'>"&j+1&".</font>"
If instr(LCase(c_PicType),FileExt)>0 Then
response.write Replace(theFile_Name,search_key,"<font color=#FF9900>"&search_key&"</font>")&""
else
response.write "<font color=#808040>["&SizeTo(theFile_size)&"]</font>"
End if
End if
%>
</td>
</tr>
<%If Session("lbbs_pic_show")="delpic" Then '删除图片选择%>
<tr>
<td><input name="FileName" type="checkbox" id="FileName" value="<%=theFile_path&"/"&theFile_Name%>" onclick="unselectall()">选中 <a href="<%=JoinChar(c_picurl)%>Action=del&page=<%=picPage%>&FileName=<%=theFile_path&"/"&theFile_Name%>" onclick="return confirm('删除后不可恢复，你真的要删除吗？')" ><font color='#FF0000'>单个删除</font></a></td>
</tr>
<%
End If
If Session("lbbs_pic_show")="delsmallpic" Then '删除缩略图%>
<tr>
<td>
<%If theFiletosmall=false Then '无缩略图%>
<font color='#A5A5A5'>（此图无缩略图）</font>
<%elseIf theFiletosmall=true Then '未有缩略图%>
<input name="FileName" type="checkbox" id="FileName" value="<%=theFile_path&"/"&theFile_Name%>" onclick="unselectall()">选中 <a href="<%=JoinChar(c_picurl)%>Action=del&page=<%=picPage%>&FileName=<%=theFile_path&"/"&theFile_Name%>" onclick="return confirm('你真的要删除缩略图吗？')" ><font color='#FF00CC'>删除缩略图</font></a>
<%End If%>
</td>
</tr>
<%
End If
If Session("lbbs_pic_show")="smallpic" and instr(LCase(c_PicType),FileExt)>0 Then '生成缩略图选择
%>
<tr>
<td>
<%If theFiletosmall=true Then '已有缩略图%>
<font color='#A5A5A5'>（已有缩略图）</font>
<%elseIf theFiletosmall=false Then '未有缩略图%>
<input name="FileName" type="checkbox" id="FileName" value="<%=theFile_path&"/"&theFile_Name%>" onclick="unselectall()">选中 <a href="<%=JoinChar(c_picurl)%>Action=small&page=<%=picPage%>&FileName=<%=theFile_path&"/"&theFile_Name%>" onclick="return confirm('你真的要生成缩图吗？生成缩图需要AspJpeg组件支持（如果图片很小就无生成缩图必要）')" ><font color='#0000FF'><B>单个生成缩图</B></font></a>
<%End If%>
</td>
</tr>
<%
End If
%>
</table>
</td>
<%Else
FileCount=FileCount-1
End if
FileCount=FileCount+1
PFSize = PFSize + theFile_Size
if FileCount mod c_Page=0 then response.write "</tr></table><table border='0' cellspacing='3' style='border-color: #FF0000;'><tr class='tdbg'>"
Next
%>
</tr>
</table>
<%If Session("lbbs_pic_show")="delpic" or Session("lbbs_pic_show")="smallpic" Or Session("lbbs_pic_show")="delsmallpic" Then
%>
<table width="100%" border="0" cellpadding="0" cellspacing="0">
<tr>
<td width="180" height="30">
<input name="chkAll" type="checkbox" id="chkAll" onclick=CheckAll(this.form) value="checkbox">
选中本页显示的所有文件</td>
<td>
<%If Session("lbbs_pic_show")="delpic" Or Session("lbbs_pic_show")="delsmallpic" Then '删除图片选择%>
<input name="Action" type="hidden" id="Action" value="Del">
<input type="submit" name="Submit" value="删除选中的文件">
<!--<input type="submit" name="Submit2" value="删除当前目录所有文件" onClick="document.myform.Action.value='DelAll';">-->
<%elseIf Session("lbbs_pic_show")="smallpic" Then '生成缩图选择%>
<input name="Action" type="hidden" id="Action" value="small">
<input type="submit" name="Submit" value="选中的文件生成缩略图">
<%end if%>
</td>
</tr>
</table>
<%
end If
%>
</form>
</div>
<%
'上一页、下一页链接
If showpage="YES" Then
Dim search_keylat,sfilename,totaltitle
if search_key<>"" then
search_keylat="<font color=#FF9900>["&search_key&"]</font>"
end if
If forder = "" Then
sfilename = c_picurl &"?search_key="&search_key&"&"
Else
sfilename = c_picurl &"&search_key="&search_key&"&"
End If
Response.Write "<table><tr><td colspan=4 align=right>"
Response.Write " 共有<B>"&total&"</B>个"&search_keylat&"文件 "
Response.Write "<B>" & SizeTo(APFSize) & "</B>"
if (PageEnd-PageStart+1)<>total then
Response.Write "/本页<B><font color=#6D6D6D>" & PageEnd-PageStart+1 & "</B></font>个文件"
Response.Write "<B><font color=#6D6D6D>" & SizeTo(PFSize) & "</font></B>"
end If
Response.Write " "
IF picPage > 1 Then
Response.Write "<a title='首页' href=" & sfilename & "page=1>首页</a> <a title='上一页，第"&(picPage-1)&"页' href=" & sfilename & "page="&picpage-1&">上一页</a>"
Else
Response.Write "首页 上一页 "
End IF
IF picPage < PCount Then
Response.Write "<a title='下一页，第"&(picPage+1)&"页' href=" & sfilename & "page="&picpage+1&">下一页</a> <a title='尾页' href=" & sfilename & "page="&PCount&">尾页</a> "
Else
Response.Write "下一页 尾页 "
End IF ⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -