lbbs_pic v1.05.asp

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

<%
'**********************************************************
'**		LBBS_pic.asp
'**
'** 文件说明：乐学LBBS无限级目录图片直读系统V1.05（ASP）
'** 创建日期：2008-04-30
'** 修改日期：2008-05-21
'** 网站支持：http://www.learn365.cn/（乐学365）
'** 问题讨论：http://www.learn365.cn/context.asp?id=19002
'** 技术支持：learn365
'** 作    者：cyc
'**********************************************************
'系统变量
Option Explicit '变量定义后可用
Dim c_admin_name,c_admin_password,c_HomeName,c_HomeUrl,c_title,c_UploadDirg,c_PicType
Dim c_filelb,c_cook,con_MaxPerPage,con_Page,con_picwidth,con_picheight,c_shownane,c_TxtType
dim picurl,c_picurl,Action,totalPut,picPage,TotalPages,FileExt,picbgclass
dim UploadDir,TruePath,fso,theFolder,theFile,thisfile,FileCount,TotalSize,TotalSize_Page
dim strFileType,sqlup,rsup,strFiles,iij,strDirName,admin_login,delpic
dim forder,upforder,action_cook,c_MaxPerPage,cook_MaxPerPage,cook_MaxPerPage01
dim c_Page,cook_Page,cook_Page01,c_picwidth,cook_picwidth,cook_picwidth01
dim c_picheight,cook_picheight,cook_picheight01
dim starttime:starttime = timer()
dim c_poweredby:c_poweredby ="v1.05" '系统版本号

'============参数设置（等号“=”前后不要留空）===================

c_admin_name="admin"   '管理员名称
c_admin_password="7a57a5a743894a0e"    '管理密码(用MD5加密，如果忘记，请改为“7a57a5a743894a0e”,密码即是“admin”）

c_HomeName="<< 乐学首页"    '网站首页链接名称（空值则不显示）
c_HomeUrl="http://www.learn365.cn/"    '网站首页链接地址
c_title="乐学LBBS图片库" '标题名
c_UploadDirg="lbbs_pic"   '图片所在文件夹
c_PicType="jpg|gif|png|bmp" '图片类型 (可使用|将图片格式分开)
c_TxtType="doc|xls|txt|rar|ppt" '非图片文件类型 (可使用|将文件格式分开)
c_filelb="是"   '左则是否显示当前目录下文件。（是：显示，否则不显示）
c_cook="是"   '是否显示并允许使用自定义功能。（是：可用，否则不可用）
c_shownane="是"  '是否中图片下显示图片文件名。（是：显示，否则不显示）

con_MaxPerPage=20     '每页显示图片数
con_Page=5      '每行显示图片数
con_picwidth=140    '图片缩图宽度
con_picheight=120    '图片缩图高度


'=============================================================


If c_UploadDirg="" Then
   Response.write "未设置图片所在文件夹，程序停止执行。"
   Response.End
End If

'转换参数，以便后台管理设置
c_filelb = Replace(c_filelb,"是","YES")
c_cook = Replace(c_cook,"是","YES")
c_shownane = Replace(c_shownane,"是","YES")

'取文件夹路径/目录
forder=request("forder")
forder=Replace(forder,"\","/") '转换\为/，保证弹窗跳转路径正确
If forder="" Then forder=c_UploadDirg
if inStr(forder,"//")<>0 Then forder = Replace( forder ,"//","/" )
If instr(forder,"../")>0 Or instr(forder,"./")>0 Or forder="/" Or forder="." Then
   Response.write "<script language='javascript'>alert('文件夹路径有误！');history.go(-1);</script>"
   Response.End
End If
If Left(forder,1)="/" Then forder=right(forder,len(forder)-1)
If right(forder,1)="/" Then forder=left(forder,len(forder)-1)


'取上层文件夹/目录
if instr(forder,"/")>0 then 
      upforder=left(forder,instrrev(forder,"/")-1)    'upforder当前目录去末尾的/
end If

'取目录实际路径
TruePath=Server.MapPath(forder)

'取当前文件路径/文件名
picurl=Request.ServerVariables("script_name")
If forder = "" Then
   c_picurl = picurl
Else
   c_picurl = picurl &"?forder="&forder&""
End If

Action=LCase(trim(Request("Action")))
   

'页码
picPage=trim(request("page"))
if picPage<>"" then
    picPage=cint(picPage)
else
	picPage=1
end if

'管理员登录检查
admin_login=false
If Session("lbbs_pic_UserName")=c_admin_name And Session("lbbs_pic_password")=c_admin_password Then
   admin_login=True
end if

'-----------------------------------
'自定义每页图片数、行数、宽度、高度
If c_cook   =  "YES" then
action_cook = request("action_cook")

Select Case action_cook
Case "cookies"
    cook_MaxPerPage = trim(replace(request("cook_MaxPerPage")," ",""))
    cook_Page       = trim(replace(request("cook_Page")," ",""))
    cook_picwidth   = trim(replace(request("cook_picwidth")," ",""))
    cook_picheight  = trim(replace(request("cook_picheight")," ",""))
    
    if  not(IsNumeric(cook_MaxPerPage)) then
       Response.write "<script language='javascript'>alert('第页图片数：你输入的不是纯数字，请输入1-30之间的数字！');history.go(-1);</script>"
       Response.end
    elseif   cook_MaxPerPage<1  or cook_MaxPerPage>30 then
       Response.write "<script language='javascript'>alert('第页图片数：请输入1-30之间的数字！');history.go(-1);</script>"
       Response.end
    end if
    if  not(IsNumeric(cook_Page)) then
       Response.write "<script language='javascript'>alert('每行图片数：你输入的不是纯数字，请输入正确数字！');history.go(-1);</script>"
       Response.end
    elseif   cook_Page<1  or cook_Page>10 then
       Response.write "<script language='javascript'>alert('每行图片数：请输入1-10之间的数字！');history.go(-1);</script>"
       Response.end
    end if
    if  not(IsNumeric(cook_picwidth)) then
       Response.write "<script language='javascript'>alert('图片宽度：你输入的不是纯数字，请输入正确数字！');history.go(-1);</script>"
       Response.end
    elseif   cook_picwidth<20  or cook_Page>800 then
       Response.write "<script language='javascript'>alert('图片宽度：请输入20-800之间的数字！');history.go(-1);</script>"
       Response.end
    end if
    if  not(IsNumeric(cook_picheight)) then
       Response.write "<script language='javascript'>alert('图片高度：你输入的不是纯数字，请输入正确数字！');history.go(-1);</script>"
       Response.end
    elseif   cook_picheight<20  or cook_picheight>800 then
       Response.write "<script language='javascript'>alert('图片高度：请输入20-800之间的数字！');history.go(-1);</script>"
       Response.end
    end If
    
    Response.cookies("cycpic")("cook_MaxPerPage") = cook_MaxPerPage
    Response.cookies("cycpic")("cook_Page")       = cook_Page
    Response.cookies("cycpic")("cook_picwidth")   = cook_picwidth
    Response.cookies("cycpic")("cook_picheight")  = cook_picheight

    if cook_MaxPerPage<>"" and cook_Page<>"" and cook_picwidth<>"" and cook_picheight<>"" then
       Select Case Request.Form("CookieTime")
    		Case 1
    			Response.cookies("cycpic").Expires=Date+1
    		Case 2
    			Response.cookies("cycpic").Expires=Date+7
	    	Case 3
		    	Response.cookies("cycpic").Expires=Date+31
	    	Case 4
		    	Response.cookies("cycpic").Expires=Date+365
       End Select
    end If

Case "con"
    Response.cookies("cycpic")("cook_MaxPerPage") = con_MaxPerPage
    Response.cookies("cycpic")("cook_Page")       = con_Page
    Response.cookies("cycpic")("cook_picwidth")   = con_picwidth
    Response.cookies("cycpic")("cook_picheight")  = con_picheight
End Select
End If
'---------------------------------

cook_MaxPerPage = Request.cookies("cycpic")("cook_MaxPerPage")
cook_Page       = Request.cookies("cycpic")("cook_Page")
cook_picwidth   = Request.cookies("cycpic")("cook_picwidth")
cook_picheight  = Request.cookies("cycpic")("cook_picheight")
if cook_MaxPerPage="" then c_MaxPerPage = con_MaxPerPage  else c_MaxPerPage = cook_MaxPerPage 
if cook_Page="" then       c_Page       = con_Page        else c_Page       = cook_Page 
if cook_picwidth="" then   c_picwidth   = con_picwidth    else c_picwidth   = cook_picwidth 
if cook_picheight="" then  c_picheight  = con_picheight   else c_picheight  = cook_picheight


'------------------------------------------------
'上一页、下一页链接
sub showpage(sfilename,totalnumber,c_MaxPerPage)
	dim n, i,strTemp
	c_MaxPerPage=CInt(c_MaxPerPage)
	if totalnumber mod c_MaxPerPage=0 then
    	n= totalnumber \ c_MaxPerPage
  	else
    	n= totalnumber \ c_MaxPerPage+1
  	end If
	If totalnumber=0 Then 
	   Exit Sub 
	End if
	sfilename=JoinChar(sfilename)
  	strTemp= "<table align='center'><form name='showpages' method='Post' action='" & sfilename & "'><tr><td>"
	strTemp=strTemp & "当前目录下共 <b>" & totalnumber & "</b> 个文件，占用 <b>" & SizeTo(TotalSize)& "</b>&nbsp;&nbsp;&nbsp;"
  	if picPage<2 then
    		strTemp=strTemp & "首页 上一页&nbsp;"
  	else
    		strTemp=strTemp & "<a  title='首页' href='" & sfilename & "page=1'>首页</a>&nbsp;"
    		strTemp=strTemp & "<a  title='上一页' href='" & sfilename & "page=" & (picPage-1) & "'>上一页</a>&nbsp;"
  	end if

  	if n-picPage<1 then
    		strTemp=strTemp & "下一页 尾页"
  	else
    		strTemp=strTemp & "<a  title='下一页' href='" & sfilename & "page=" & (picPage+1) & "'>下一页</a>&nbsp;"
    		strTemp=strTemp & "<a  title='尾页' href='" & sfilename & "page=" & n & "'>尾页</a>"
  	end if
   	strTemp=strTemp & "&nbsp;页次：<strong><font color=red>" & picPage & "</font>/" & n & "</strong>页 "
    strTemp=strTemp & "&nbsp;<b>" & c_MaxPerPage & "</b>" & "个文件/页"
	strTemp=strTemp & "&nbsp;转到：<select name='page' size='1' onchange='javascript:submit()'>"   
    for iij = 1 to n   
   		strTemp=strTemp & "<option value='" & iij & "'"
		if cint(picPage)=cint(iij) then strTemp=strTemp & " selected "
		strTemp=strTemp & ">第" & iij & "页</option>"   
	next
	strTemp=strTemp & "</select>"
	strTemp=strTemp & "</td></tr></form></table>"
	response.write strTemp
end sub
'------------------------------------------------

'------------------------------------------------
'函数名：IsObjInstalled 检查组件是否已经安装（参  数：strClassString ----组件名）
'返回值：True  ----已经安装  False ----没有安装
Function IsObjInstalled(strClassString)
    On Error Resume Next
    IsObjInstalled = False
    Err = 0
    Dim xTestObj
    Set xTestObj = Server.CreateObject(strClassString)
    If 0 = Err Then IsObjInstalled = True
    Set xTestObj = Nothing
    Err = 0
End Function

'------------------------------------------------
'函数名：JoinChar
'作  用：向地址中加入 ? 或 &
'参  数：strUrl  ----网址
'返回值：加了 ? 或 & 的网址
function JoinChar(strUrl)
	if strUrl="" then
		JoinChar=""
		exit function
	end if
	if InStr(strUrl,"?")<len(strUrl) then 
		if InStr(strUrl,"?")>1 then
			if InStr(strUrl,"&")<len(strUrl) then 
				JoinChar=strUrl & "&"
			else
				JoinChar=strUrl
			end if
		else
			JoinChar=strUrl & "?"
		end if
	else
		JoinChar=strUrl
	end if
end Function
'------------------------------------------------

'------------------------------------------
'目录存在时显示此目录下的所有子目录
Function ShowFolderList(folderspec)
On Error Resume Next
Dim f,f1,f2,fc,fc2,s,fs,jj,Filenames,FileSize,i,pj,pj2,picFile,picExt
Set f = fso.GetFolder(folderspec)
Set fc = f.SubFolders
jj=1
For Each f1 in fc
    pj=0
	pj2=0
	For Each picFile In f1.Files
	  picExt=LCase(Right(Trim(picFile.name),3))
	  If instr(LCase(c_PicType),picExt)>0 Then
		  pj=pj+1
      ElseIf instr(LCase(c_TxtType),picExt)>0 then
          pj2=pj2+1
	  End If	
	Next
	If CInt(pj)>0 Then pj=" "&pj&"P" Else pj=""
	If CInt(pj2)>0 Then pj2=" "&pj2&"F" Else pj2=""
s = s & "<a title='"&f1.name&"' href='?forder="&forder&"/"&f1.name&"'><img  border='0' src='images/folder.gif' width='16' height='16'>"
s = s &"<font color='#0066FF'>"&jj&"."& f1.name&"</font>"& pj & pj2 &"</a>"
s = s &"<br>"
jj=jj+1

Next
If jj-1=0 then s = s &"(当前目录无下层文件夹)<BR>"
         If c_filelb  =  "YES"  then 
         '读取该文件夹下所有文件
          Set  fc2  =  f.Files  
		  i=1
		  For  Each  f2  in  fc2  
            Filenames=  f2.name    
            FileSize=  f2.Size
			FileExt = fso.GetExtensionName(Filenames)	'获得文件的扩展名
			if FileExt<>"" then
				FileExt = Lcase(FileExt)
			end if
            If Len(Filenames)>20 Then  Filenames=Left(Filenames,20)&".."
			If instr(LCase(c_PicType),FileExt)>0 or instr(LCase(c_TxtType),FileExt)>0 Then
			   s = s &"<a href='"&Server.URLEncode(forder &"\"& f2.Name)&"' target='_blank'  title='[文件]"&f2.name &Chr(10)&"[大小]"&SizeTo(FileSize)&"'>"
			   s = s &"<img src='images/" & FileExt & ".gif' border='0' onerror=""this.src='images/Unknown.gif';"" HEIGHT='17'>"
			   s = s &"<font color='#0066FF'>"&i&".</font>"&Filenames&"</a><BR>"
            Else            
			   i=i-1
            End If
            i=i+1 
         Next 
			If i-1=0 then s = s &"(当前目录无文件)<BR>"
         End if
ShowFolderList = s
End Function
'===========================================

'===========================================
   '转换文件大小转换 
    Function SizeTo(PFSize) 
        SizeTo=0 
        IF PFSize>(1024*1024*1024) And (PFSize/1024/1024/1024)>0 Then 
            'GB转换 
            SizeTo=FormatNumber(PFSize/1024/1024/1024,2)&" GB" 
        ElseIF PFSize>(1024*1024) And (PFSize/1024/1024)>0 Then 
            'MB转换 
            SizeTo=FormatNumber(PFSize/1024/1024,2)&" MB" 
        ElseIF PFSize>1024 And (PFSize/1024)>0 Then 
            'KB转换 
            SizeTo=FormatNumber(PFSize/1024,2)&" KB" 
        ElseIF PFSize>0 Then 
            'byte转换 
            SizeTo="0"&FormatNumber(PFSize/1024,3)&" KB" 
			'SizeTo=PFsize&" Byte(字节)"
        Else 
            SizeTo=0&" Byte(字节)" 
        End IF 
    End Function 
'===========================================

'===========================================
'过修改目录、创建目录时不能使用的滤特殊字符（/\:*?"<>|）与空格
function forderyes(str)
  str=replace(str,chr(47),"") '过滤>
  str=replace(str,"\","") '过滤\
  str=replace(str,"*","") '过滤>*
  str=replace(str,chr(58),"") '过滤:
  str=replace(str,chr(63),"") '过滤?
  str=replace(str,chr(34),"") '过滤"
  str=replace(str,chr(60),"") '过滤<
  str=replace(str,chr(62),"") '过滤>
  str=replace(str,"|","") '过滤|
  str=replace(str," ","") '过滤空格 
  forderyes=str
End Function
'===========================================

'=========================================
'判断文件类型
Function CheckFileExt(fileName, picType)