lbbs_pic v1.06.asp

乐学LBBS无限级目录图片直读系统 v1.09 build 20080719 很好用的大家试试看

  </tr>
<%
 End if 

'==========================================
If not IsObjInstalled("Scripting.FileSystemObject") Then
	Response.Write "<b><font color=red>你的服务器不支持 FSO(Scripting.FileSystemObject)! 不能显示文件</font></b>"
Else
	set fso=CreateObject("Scripting.FileSystemObject")
	Select Case Action
	Case "admin"
	    '管理设置
		call admin()
	Case "adminsave"
	    '保存设置
		call adminsave()
	Case  "login"
	    '管理登录
		call adminlogin()
	Case  "logincheck"
	    '检查登录
		call logincheck()
	Case  "logout"
	    '退出登录
	    call adminlogout()
	Case   "delpic"
        '显示删除选项
         Call admincheck() '登录检测
         Session("lbbs_pic_show")="delpic"
         response.redirect (JoinChar(c_picurl)&"page="&picPage)  
	Case   "smallpic"
        '显示生成缩图选项
         Call admincheck() '登录检测
         Session("lbbs_pic_show")="smallpic"
         response.redirect (JoinChar(c_picurl)&"page="&picPage)  
 	Case   "nodelpic"
        '不显示删除选项
         Session("lbbs_pic_show")=""
         response.redirect (JoinChar(c_picurl)&"page="&picPage)  
	Case   "small"
        '选中文件生成缩图
		call smallFiles()	
	Case   "del"
        '删除选中文件
		call DelFiles()		
	Case  "delall"
	    '删除当前目录所有文件
		call DelAll()
	Case   "moddir"
        '修改目录
		call Moddir()		
	Case  "moddirsave"
	    '保存修改的目录
		call Moddirsave()		
	Case   "adddir"
        '创建新目录
		call adddir()		
	Case  "adddirsave"
	    '保存新创建的目录
		call adddirsave()	
	Case   "deldir"
        '创建新目录
		call deldir()		
	Case  "deldirsave"
	    '保存新创建的目录
		call deldirsave()	
	Case   "upload"
        '上传文件选择
		call upload()		
	Case  "uploadsave"
	    '处理上传文件
		call uploadsave()	

	Case Else
	     '浏览图片
        call showpic()
	end Select
	set fso = Nothing
%>
</table>

<%
call copyright() '版本信息
end If
'========================================

'========================================
 '浏览图片
Sub showpic()
%>
<%If Session("lbbs_pic_show")="smallpic" then '生成缩略图标题行%>
	<tr>
		<td colspan="2" bgcolor="#4ACCDB" height="25">
		<p><b>生成缩略图<font color="#FFFFFF">（生成缩略图的AspJpeg组件<%ShowObjectInstalled("Persits.Jpeg")%>，缩略图文件名以“</font><font color="#FFFF00">_[small]</font><font color="#FFFFFF">”结尾）</font></b></p></td>
	</tr>
<%
end if
If Session("lbbs_pic_show")="delpic" then '删除文件标题行
%>
	<tr>
		<td colspan="2" bgcolor="#FF9966" height="25">
		<p align="left"><b>删除文件<font color="#FFFFFF">（请慎重使用：文件一旦删除，将不可恢复。）</font></b></p></td>
	</tr>
<%end if%>
  <tr class="tdbg"> 
    <td height="24" style="width: 238px">
	<a title='返回总目录' href='<%=picurl%>'><img alt='' border='0' src='images/alllist.gif' width='16' height='16'>总目录</a><br>
	<%if forder<>"" then response.write"<a title='↑向上…上层目录' href='?forder="&upforder&"'><img alt='' border='0' src='images/up.gif' width='16' height='16'>返回上层目录</a>"%>
</td>
 <td height="24" style="width: 800px; height: 12px;">
转到目录：<select size="1" name="forder"  onchange="javascript:window.location='?forder='+this.options[this.selectedIndex].value;">
<option value="" style="COLOR: #808000" selected>--请选择图片目录--</option>   
<option value="">--总目录--</option>   
<% call bl(0,"◆",c_UploadDirg) '遍历站点所有文件夹作为下拉列表 %>   
</select> 
<BR>当前位置：<font color='#0000ff'><%=replace(replace(forder,".",""),c_UploadDirg,"总目录")%></font>
</td>
  </tr>
 <tr class="tdbg"> 
    <td height="30" style="width: 238px;" valign="top">
   <% Response.write (ShowFolderList(TruePath))'左侧目录文件列表 %>
    </td>
    <td height="30" style="height: 15px; width: 800px;" valign="top">
   <% call main()'图片列表 %>	
	</td>
  </tr>
<%
End Sub
'========================================

'========================================
'遍历站点所有文件夹作为下拉列表
'i全角的空格（　）数
'sty符号
'strpath文件夹路径
function bl(i,sty,strpath)
Dim objfolder,objfile,newstrpath,picFile,pi,pi2,picExt,objsubfolder  
set objfolder=fso.getfolder(server.mappath(strpath)) 
for each objsubfolder in objfolder.subfolders
    pi=0
	pi2=0
	For Each picFile In objsubfolder.Files
	  picExt=LCase(Right(Trim(picFile.name),3))
	  If instr(LCase(c_PicType),picExt)>0 And instr(LCase(picFile.name),"_[small]")=0 Then
		  pi=pi+1
      ElseIf instr(LCase(c_TxtType),picExt)>0  And Session("lbbs_pic_show")<>"smallpic" then
          pi2=pi2+1
	  End If	
	Next
	If CInt(pi)>0 Then pi=" "&pi&"P" Else pi=""
	If CInt(pi2)>0 Then pi2=" "&pi2&"F" Else pi2=""
Response.write ("<option value='" & strpath & "/"& objsubfolder.name & "'")
if forder=strpath& "/"& objsubfolder.name then
   Response.write (" style='COLOR: #0000ff'  selected ")
end If
Response.write (">"&string(i,"　")&""& sty & objsubfolder.name & pi & pi2 &"</option>")
i=i+1
call bl(i+1," ",strpath & "/"& objsubfolder.name)  
i=i-1
next 
End function 
'========================================

'========================================
'图片列表
sub main()
    Dim picExe1
	if fso.FolderExists(TruePath)=False then
		response.write "找不到文件夹！可能是配置有误！"
		exit sub
	end if
	
	FileCount=0
	TotalSize=0
	Set theFolder=fso.GetFolder(TruePath)
	For Each theFile In theFolder.Files
        picExe1=LCase(Right(Trim(theFile.name),3))
		If (instr(LCase(c_PicType),picExe1)>0 And instr(LCase(theFile.name),"_[small]")=0)  Or (instr(LCase(c_TxtType),picExe1)>0  And Session("lbbs_pic_show")<>"smallpic") Then
		   FileCount=FileCount+1
		   TotalSize=TotalSize+theFile.Size
		End if
	next
	totalPut=FileCount
	if picPage<1 then
		picPage=1
	end if
	if (picPage-1)*c_MaxPerPage>totalput then
		if (totalPut mod c_MaxPerPage)=0 then
			picPage= totalPut \ c_MaxPerPage
		else
			picPage= totalPut \ c_MaxPerPage + 1
		end if
			end if
	if picPage=1 then
		call showContent()     	
		Call showpage(c_picurl,totalput,c_MaxPerPage)
	else
		if (picPage-1)*c_MaxPerPage<totalPut then
			call showContent()     	
			call showpage(c_picurl,totalput,c_MaxPerPage)
		else
			picPage=1
			call showContent()     	
			call showpage(c_picurl,totalput,c_MaxPerPage)
		end if
	end if
end sub

sub showContent()
   	dim c
	FileCount=0
	TotalSize_Page=0
%>
</p>
<table width='100%' border="0" cellpadding="0" cellspacing="0">
<%
'--自定义开始--
If c_cook  =  "YES" Then
%>
  <form method="POST" action="<%=JoinChar(c_picurl)%>action_cook=cookies">
					<tr  class="tdbg">
						<td height="30" width="756">
				<p align="left">
				自定义：<span class="style3">每页图片数</span><input type="text" name="cook_MaxPerPage" size="5" value="<%=c_MaxPerPage%>" style="border: 1px solid #808000; width: 25px;" title="输入1-30之间的数字！"><span class="style3"> 
				每行图片数</span><input type="text" name="cook_Page" size="12" value="<%=c_Page%>" style="border: 1px solid #808000; width: 21px;" title="输入1-10之间的数字！">&nbsp; 
				图片宽<input type="text" name="cook_picwidth" size="10" value="<%=c_picwidth%>" style="border: 1px solid #808000; width: 42px;" title="输入20-800之间的数字！">
				高<input type="text" name="cook_picheight" size="10" value="<%=c_picheight%>" style="border: 1px solid #808000; width: 39px;" title="输入20-800之间的数字！"></font>&nbsp;
				<select size="1" name="CookieTime" class="input">
				<option selected value="0">是否记忆</option>
				<option value="1">记忆一天</option>
				<option value="2">记忆一周</option>
				<option value="3">记忆一月</option>
				<option value="4">记忆一年</option>
				</select>
				
				<input type="submit" value="提交" name="B1">&nbsp;
				<input type="button" value="恢复默认值" name="B3"  onClick="window.location.href='<%=JoinChar(c_picurl)%>action_cook=con'">
</p>
			</td>
					</tr>
				</form>
</table>
<%End If
'--自定义结束--
call showpage(c_picurl,totalput,c_MaxPerPage) '分页链接
%>
<table width='100%' border="0" cellpadding="0" cellspacing="0">
  <tr>
     <td>
<form name="myform" method="Post" action="?forder=<%=forder%>&page=<%=picPage%>" onsubmit="return confirm('你确定要执行操作吗？');">
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="3" class="border">
  <tr class="tdbg">
    <%
	Dim theFile_small,theFiletosmall,theFilesrcurl
For Each theFile In theFolder.Files
	c=c+1
	if FileCount>=Int(c_MaxPerPage) then
		exit for
	elseif c>Int(c_MaxPerPage)*(picPage-1) then
	'strFileType=lcase(mid(theFile.Name,instrrev(theFile.Name,".")+1))
	FileExt = fso.GetExtensionName(theFile.Name)	'获得文件的扩展名
	if FileExt<>"" then
	   FileExt = Lcase(FileExt)
	end If
	If Session("lbbs_pic_show")="delpic" Then '点击“删除图片”时背景色样式
	   picbgclass="pic_delstyle"
	Elseif Session("lbbs_pic_show")="smallpic" Then '点击“生成缩图”时背景色样式
	   picbgclass="pic_smallstyle"	
	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") Then
%>
    <td>
      <table width="100%" height="100%" border="0" cellpadding="0">
        <tr>
          <td align="center" width="<%=c_picwidth%>" height="<%=c_picheight+10%>" 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(forder &"/"&theFile_small)) Then '检查缩略图是否存在	
                   theFile_small=theFile_small
                   theFiletosmall=True                   
				Else
				   theFile_small=theFile.Name
				   theFiletosmall=false
			    End If				
			  	response.write "<a href='"&URLEncode(forder &"\"& theFile.Name)&"' target='_blank'><img src='"&URLEncode(forder &"\"& theFile_small)&"' alt='[文件] "&theFile.Name&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='"&theFilesrcurl&"' target='_blank'><img src='images/" & FileExt & ".gif' border='0'  onmouseover=""this.style.cursor='hand';"" class='imgmid' onerror=""this.src='images/noknow.gif';""><font color='#0066FF' 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'>"&c&".</font>"
				If instr(LCase(c_PicType),FileExt)>0 Then
				   response.write  theFile.Name&"&nbsp;["&SizeTo(theFile.size)&"]"
                 Else
 				   response.write  "["&SizeTo(theFile.size)&"]"
				End if
			End if
		  %>
          </td>
        </tr>
        <%If Session("lbbs_pic_show")="delpic" Then '删除图片选择%>
        <tr>
          <td><input name="FileName" type="checkbox" id="FileName" value="<%=theFile.Name%>" onclick="unselectall()">选中  <a href="<%=JoinChar(c_picurl)%>Action=Del&page=<%=picPage%>&FileName=<%=theFile.Name%>" onclick="return confirm('删除后无法恢复，你真的要删除吗？')" ><font color='#FF0000'>单个删除</font></a></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.Name%>" onclick="unselectall()">选中  <a href="<%=JoinChar(c_picurl)%>Action=small&page=<%=picPage%>&FileName=<%=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
		c=c-1
    End if
		FileCount=FileCount+1
		if FileCount mod c_Page=0 then response.write "</td><tr class='tdbg'>"
		TotalSize_Page=TotalSize_Page+theFile.Size
	end If
Next
%>
  </tr>
</table>
<%If Session("lbbs_pic_show")="delpic" or  Session("lbbs_pic_show")="smallpic" 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" Then '删除图片选择%>