lbbs_pic v1.0.asp

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

<%
'**************************************
'**		LBBS_pic.asp
'**
'** 文件说明：乐学LBBS无限级目录图片直读系统V1.0（ASP）
'** 创建日期：2008-04-30
'** 修改日期：2008-04-30
'** 网    站：http://www.learn365.cn/
'** 作    者：CYC
'**************************************
'系统变量
Dim c_HomeName,c_HomeUrl,c_title,c_filelb,c_cook
dim c_strFileName,cPicType,Action,totalPut,CurrentPage,TotalPages,upforder2
dim UploadDir,TruePath,fso,theFolder,theFile,thisfile,FileCount,TotalSize,TotalSize_Page
dim strFileType,sqlup,rsup,strFiles,iij,strDirName,c_strFileName2,c_UploadDirg
dim forder,upforder,action_cook,c_MaxPerPage,con_MaxPerPage,cook_MaxPerPage,cook_MaxPerPage01
dim c_Page,con_Page,cook_Page,cook_Page01,c_picwidth,con_picwidth,cook_picwidth,cook_picwidth01
dim c_picheight,con_picheight,cook_picheight,cook_picheight01
dim starttime:starttime = timer()
dim c_poweredby:c_poweredby =" V1.0" '系统版本号

'============参数设置==========================================

c_HomeName        =  "<< 返回首页"    '网站首页链接名称（空值则不显示）
c_HomeUrl         =  "http://www.learn365.cn/"    '网站首页链接地址
c_title           =  "乐学LBBS图片库" '标题名
c_c_filelb        =  "是"   '左则是否显示当前目录下文件。（是：显示，否则不显示）
c_cook            =  "是"   '是否显示并允许使用自定义功能。（是：可用，否则不可用）
c_UploadDirg      =  "lbbs_pic"   '图片所在文件夹（"../"表示上一层，"./"表示当前）

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

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

UploadDir =c_UploadDirg 
If UploadDir = "" Then   UploadDir="./"
if right(UploadDir,1)<>"/" or right(UploadDir,1)<>"\" then
	  UploadDir=UploadDir & "/"
End if
   
forder=request("forder")

if forder<>"" then 
   if right(forder,1)<>"/" then
	  forder=forder & "/"
   End If
   UploadDir=UploadDir&forder
end If

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

TruePath=Server.MapPath(UploadDir)
if upforder2<>"" then
   TruePath2=Server.MapPath(upforder2)
end If

c_strFileName=Request.ServerVariables("script_name")
If forder = "" Then
   c_strFileName = c_strFileName
   c_strFileName2 = c_strFileName
Else
   c_strFileName2 = c_strFileName
   c_strFileName = c_strFileName &"?forder="&forder&"&"
End If

Action=trim(Request("Action"))

if trim(request("page"))<>"" then
    currentPage=cint(request("page"))
else
	currentPage=1
end if

'-----------------------------------
'自定义每页图片数、行数、宽度、高度
If c_cook   =  "是" 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

%>
</body> 
</html>
<%
'------------------------------------------------
'上一页、下一页链接
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
  	strTemp= "<table align='center'><form name='showpages' method='Post' action='" & sfilename & "'><tr><td>"
	strTemp=strTemp & "当前目录下共 <b>" & totalnumber & "</b> 个文件，占用 <b>" & TotalSize\1024 & "</b> K&nbsp;&nbsp;&nbsp;"
	sfilename=JoinChar(sfilename)
  	if CurrentPage<2 then
    		strTemp=strTemp & "首页 上一页&nbsp;"
  	else
    		strTemp=strTemp & "<a  title='首页' href='" & sfilename & "page=1'>首页</a>&nbsp;"
    		strTemp=strTemp & "<a  title='上一页' href='" & sfilename & "page=" & (CurrentPage-1) & "'>上一页</a>&nbsp;"
  	end if

  	if n-currentpage<1 then
    		strTemp=strTemp & "下一页 尾页"
  	else
    		strTemp=strTemp & "<a  title='下一页' href='" & sfilename & "page=" & (CurrentPage+1) & "'>下一页</a>&nbsp;"
    		strTemp=strTemp & "<a  title='尾页' href='" & sfilename & "page=" & n & "'>尾页</a>"
  	end if
   	strTemp=strTemp & "&nbsp;页次：<strong><font color=red>" & CurrentPage & "</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(CurrentPage)=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
'------------------------------------------------

'------------------------------------------------

Sub ShowObjectInstalled(strObjName)
	If IsObjInstalled(strObjName) Then
		Response.Write "<font color='#99CCFF'><b>√</b></font>"
	Else
		Response.Write "<font color='red'><b>×</b>(无)</font>"
	End If
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, fc, s ,fs,jj
set fs=CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
s = s &"<BR><B>当前目录下文件夹：</B><br>"
Set fc = f.SubFolders
jj=1
For Each f1 in fc
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></a><br>"
jj=jj+1
Next
If jj-1=0 then s = s &"(无)<BR>"
         If c_c_filelb  =  "是"  then 
         s = s &"<BR><B>当前目录下文件：</B>"
         '读取该文件夹下所有文件
          Set  fc2  =  f.Files  
		  i=1
		  For  Each  f1  in  fc2  
            Filenames=  f1.name    
            FileSize=  f1.Size
            If Len(Filenames)>20 Then  Filenames=Left(Filenames,20)&".."
			s = s &"<BR><a href='" & UploadDir & f1.name & "' target='_blank'  alt='[文件]"&f1.name &Chr(10)&"[大小]"&round(FileSize\1024)&"K'>"
			s = s &"<img  border='0' src='images/file.gif' width='16' height='16'>"
			s = s &"<font color='#0066FF'>"&i&".</font>"&Filenames&"</a>"
		    i=i+1 
         Next 
			If i-1=0 then s = s &"<BR>(无)"
         End if
ShowFolderList = s
End Function
'-------------------------------------------

'===========================================
function strvalue(str,lennum)	'截取字符串，支持中英文混用
dim p_num,x 
dim i 
if strlen(str)<=lennum then 
strvalue=str 
else 
p_num=0 
x=0 
do while not p_num > lennum-2 
x=x+1 
if asc(mid(str,x,1))<0 then 
p_num=int(p_num) + 2 
else 
p_num=int(p_num) + 1 
end if 
strvalue=left(trim(str),x)&"…" 
loop 
end if 
end function 
'===========================================
%>

<html>
<head>
<title><%=c_title%></title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<STYLE>
BODY {
	FONT-SIZE: 9pt; BACKGROUND: #ffffff; LINE-HEIGHT: 150%; FONT-FAMILY: "宋体";TEXT-DECORATION: none
}

TD {
	FONT-SIZE: 9pt; FONT-FAMILY: "宋体"
}
INPUT {
	FONT-SIZE: 9pt; HEIGHT: 20px
}
BUTTON {
	FONT-SIZE: 9pt; HEIGHT: 20px
}
SELECT {
	FONT-SIZE: 9pt; HEIGHT: 20px
}
A {
	COLOR: #000000; TEXT-DECORATION: none
}

.title {
	
}
.border {