lbbs_pic v1.07.asp

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

<%
'**********************************************************
'** 文 件 名：LBBS_pic.asp  （可以改名）
'**
'** 文件说明：乐学LBBS无限级目录图片直读系统V1.07（ASP）
'** 创建日期：2008-04-30
'** 修改日期：2008-07-05
'** 网站支持：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,c_PicPaixutime
dim forder,upforder,action_cook,c_MaxPerPage,cook_MaxPerPage,c_showmouseover
dim c_Page,cook_Page,c_picwidth,cook_picwidth,c_URLEncode,c_search,c_PicPaixu,c_orderBy
dim c_picheight,cook_picheight,cook_picheight01,con_pic_small_w,con_pic_small_h,con_filelbtablew
dim action_search,search_key,search_scope
dim starttime:starttime = timer()
dim c_poweredby:c_poweredby ="v1.07" '系统版本号

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

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"   '图片所在文件夹,如“lbbs_pic/pic”,开头与结尾不能带“/”
c_PicType="jpg|gif|png|bmp" '图片类型 (可使用|将图片格式分开)
c_TxtType="doc|xls|txt|rar|ppt" '非图片文件类型 (可使用|将文件格式分开)
c_cook="是"      '是否显示并允许使用自定义显示功能。（是：开启，否则关闭）
c_search="是"    '是否显示搜索功能。（是：开启，否则关闭）
c_shownane="是"  '是否在图片下显示图片文件名。（是：显示，否则不显示）
c_showmouseover="是"  '是否显示鼠标悬停在链接上的JS提示信息。（是：显示，否则不显示）
c_URLEncode="是"      '是否用Server.URLEncode编码图片路径，以便显示特殊文件名的图片。（是：编码，否则不编码）
c_PicPaixu="时间"      '列表图片排序方式。（默认：由系统自动排序，时间：按时间排序，大小：按文件大小排序）
c_PicPaixutime="建立"  '列表图片按什么时间排序。（建立：按建立时间排序，存取：按存取时间排序，修改：按修改时间排序）
c_orderBy="降序"       '列表图片排序。（升序：ASC，降序，DESC）
c_filelb="否"          '左则是否显示当前目录下文件。（是：显示，否则不显示）

con_filelbtablew=140  '左则目录栏至少宽度
con_MaxPerPage=20     '列表每页显示图片数
con_Page=5            '列表每行显示图片数
con_picwidth=140      '列表图片宽度
con_picheight=120     '列表图片高度
con_pic_small_w=150  '后台上传图片时生成的缩略图高度
con_pic_small_h=150  '后台上传图片时生成的缩略图高度

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

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

'转换参数，以便后台管理设置
c_filelb = Replace(c_filelb,"是","YES")
c_cook = Replace(c_cook,"是","YES")
c_search = Replace(c_search,"是","YES")
c_shownane = Replace(c_shownane,"是","YES")
c_showmouseover=Replace(c_showmouseover,"是","YES") 
c_URLEncode=Replace(c_URLEncode,"是","YES") 
c_PicPaixu=Replace(Replace(Replace(c_PicPaixu,"时间","TIME"),"默认","NAME"),"大小","SIZE")
c_PicPaixutime=Replace(Replace(Replace(c_PicPaixutime,"建立","CR"),"存取","LA"),"修改","LM") 
c_orderBy=Replace(Replace(c_orderBy,"升序","ASC"),"降序","DESC") 


Action=LCase(trim(Request("Action")))
action_search=LCase(trim(Request("action_search")))
search_key=trim(Request("search_key"))
search_scope=trim(Request("search_scope"))

'取文件夹路径/目录
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


'管理员登录检查
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


'------------------------------------------------
'函数名：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

Sub ShowObjectInstalled(strObjName)
	If IsObjInstalled(strObjName) Then
		Response.Write "<b><font color='#0094D8'>√</font></b>"
	Else
		Response.Write "<font color='red'><b>×</b>(无)</font>"
	End If
End Sub
'------------------------------------------------
'函数名：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 And instr(LCase(picFile.name),"_[small]")=0 and instr(LCase(picFile.name),search_key)>0 Then
		  pj=pj+1
      ElseIf instr(LCase(c_TxtType),picExt)>0 And Session("lbbs_pic_show")<>"smallpic" and instr(LCase(picFile.name),search_key)>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 And instr(LCase(f2.name),"_[small]")=0) or (instr(LCase(c_TxtType),FileExt)>0) And Session("lbbs_pic_show")<>"smallpic") and instr(LCase(f2.Name),search_key)>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)
Dim ext,typeList,ii
	ext =  right(fileName, 3)
	CheckFileExt = False
	typeList = split(picType, "|")
	For ii = LBound(typeList) To UBound(typeList)
		If UCase(ext) = UCase(typeList(ii)) Then
			CheckFileExt = True
			Exit For
		End If
	Next
End Function	
'=========================================

Function UrlEncode(Str)			'对URL编码
  If c_URLEncode="YES" Then '开启Server.URLEncode编码图片路径
	 UrlEncode=Server.UrlEncode(Str)