www.gusucode.com > 深度梦想整站系统(asp) 1.14.02源码程序 > admin/soft/soft_Select.asp
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%
'强制浏览器重新访问服务器下载页面，而不是从缓存读取页面
Response.Buffer = True
Response.Expires = -1
Response.ExpiresAbsolute = Now() - 1
Response.Expires = 0
Response.CacheControl = "no-cache"
projectRootPath = "../../" '相对当前应用程序根的位置
%>
<!-- #include file="../web.config.asp"-->
<%
Const MaxPerPage=20
dim strFileName
dim Action
dim totalPut,CurrentPage,TotalPages
dim UploadDir,TruePath,fso,theFolder,theFile,thisfile,FileCount,TotalSize,TotalSize_Page
dim TotalUnit,strTotalUnit,PageUnit,strPageUnit
dim strFileType
dim sql,rs,strFiles,i
dim strDirName
Action=trim(Request("action"))
upLoadDir=trim(request("upLoadDir"))
if request("page")<>"" then
currentPage=cint(request("page"))
else
currentPage=1
end if
set rs=server.CreateObject("adodb.recordset")
select case upLoadDir
'----频道--------------------
case "channel"
savePath= site_upFilesDir & "channel"
strDirName="频道栏目的上传文件"
'----文章--------------------
case "article"
savePath= site_upFilesDir & "article"
strDirName="文章的上传图片"
'----产品--------------------
case "product"
savePath= site_upFilesDir & "product"
strDirName="产品的上传图片"
'----广告--------------------
case "drumbeating"
savePath= site_upFilesDir & "drumbeating"
strDirName="网站广告的上传图片"
'----友情链接--------------------
case "soft"
savePath= projectRootPath& "soft/" & site_upFilesDir & "soft"
strDirName="软件的上传文件"
'----友情链接--------------------
' case "friendLink"
' savePath= projectRootPath & site_upFilesDir & "friendLink"
' strDirName="友情链接的上传图片"
' sql="select flogoUrl from deep_FriendLink"
' rs.open sql,conn,1,1
' do while not rs.eof
' if rs(0)<>"" then
' strFiles=strFiles & "|" & rs(0)
' end if
' rs.movenext
' loop
'----其它 默认是 友情链接--------------------
case else
savePath= site_upFilesDir & "friendLink"
strDirName="友情链接的上传图片"
end select
strFileName="?uploadDir=" & UploadDir
if right(savePath,1)<>"/" then
savePath=savePath & "/"
end if
TruePath=Server.MapPath(savePath)
%>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta name="robots" content="noindex,nofollow" />
<meta http-equiv="Content-Type" content="text/html; charset=gb2312" />
<title>上传文件选择</title>
<link href="../themes/<%=theme_Path%>/main.css" rel="stylesheet" type="text/css" />
</head>
<body id="bodyBg1">
<br />
现在的位置：上传文件选择 > <a href='?upLoadDir=<%=trim(request("upLoadDir"))%>'><font color='red'><%=strDirName%></font></a>
<hr class="Nav-hr" />
<br />
<dl class="manageContent">
<dt>上传文件管理</dt>
<dd>
<br />
<%
if not IsObjInstalled("Scripting.FileSystemObject") Then
Response.Write "<b><font color=red>你的服务器不支持 FSO(Scripting.FileSystemObject)! 不能使用本功能</font></b>"
else
set fso=CreateObject("Scripting.FileSystemObject")
call main()
end if
%>
<br />
</dd>
</dl>
<br />
<%
'==========================================================
sub main()
if fso.FolderExists(TruePath)=False then
response.write "找不到文件夹！可能是配置有误！"
exit sub
end if
FileCount=0
TotalSize=0
Set theFolder=fso.GetFolder(TruePath)
TotalUnit=1
For Each theFile In theFolder.Files
FileCount=FileCount+1
if TotalUnit=1 then
TotalSize=TotalSize+theFile.Size/1024
elseif TotalUnit=2 then
TotalSize=TotalSize+theFile.Size/1024/1024
elseif TotalUnit=3 then
TotalSize=TotalSize+theFile.Size/1024/1024/1024
end if
if TotalSize>1024 then
TotalSize=TotalSize/1024
TotalUnit=TotalUnit+1
end if
if TotalUnit=1 then
strTotalUnit="KB"
elseif TotalUnit=2 then
strTotalUnit="MB"
elseif TotalUnit=3 then
strTotalUnit="GB"
end if
next
TotalSize = Round(TotalSize, 2)
totalPut=FileCount
if currentpage<1 then
currentpage=1
end if
if (currentpage-1)*MaxPerPage>totalput then
if (totalPut mod MaxPerPage)=0 then
currentpage= totalPut \ MaxPerPage
else
currentpage= totalPut \ MaxPerPage + 1
end if
end if
if currentPage=1 then
'
else
if (currentPage-1)*MaxPerPage<totalPut then
'
else
currentPage=1
end if
end if
call showContent
call showCount( strFileName,totalput,MaxPerPage)
response.write "<br><div align='center'>本页共显示 <b>" & FileCount & "</b> 个文件，占用 <b>" & TotalSize_Page & "</b> " & strPageUnit & "</div>"
end sub
'--显示内容---------------------
sub showContent()
dim c
FileCount=0
TotalSize_Page=0
PageUnit=1
%>
<%
For Each theFile In theFolder.Files
c=c+1
if FileCount>=MaxPerPage then
exit for
elseif c>MaxPerPage*(CurrentPage-1) then
%>
<div style="width:235px;float:left; margin:2px; border:1px dotted #666; background-color:#FFF; text-align:left; padding:3px;">
<div align="center">
<%
strFileType=lcase(mid(theFile.Name,instrrev(theFile.Name,".")+1))
select case strFileType
case "jpg","gif","bmp","png"
thsImgSrc= savePath & theFile.Name
case "swf"
thsImgSrc= "images/filetype_flash.gif"
case "wmv","avi","asf","mpg"
thsImgSrc= "images/filetype_media.gif"
case "rm","ra","ram"
thsImgSrc= "images/filetype_rm.gif"
case "rar"
thsImgSrc= "images/filetype_rar.gif"
case "zip"
thsImgSrc= "images/filetype_zip.gif"
case "exe"
thsImgSrc= "images/filetype_exe.gif"
case else
thsImgSrc= "images/filetype_other.gif"
end select
response.write "<a href='#' onclick=""javascript:window.opener.SelectFileAddUrl('"&theFile.Name&"','"&round(theFile.size/1024)&"');window.close();"" ><img src='"& thsImgSrc &"' width='140' height='100' border='0'></a>"
%>
</div>
文 件 名：<a href="<%=(savePath & theFile.Name)%>" target='_blank' <%
if instr(strFiles,theFile.Name)>0 then
else
response.write " title='无用的上传文件' style='color:#F00; font-weight:bolder;' "
end if %> ><%=theFile.Name%></a><br />
文件大小：<%=round(theFile.size/1024) & " K"%><br />
文件类型：<%=theFile.type%><br />
修改时间：<%=theFile.DateLastModified%>
</div>
<%
FileCount=FileCount+1
if PageUnit=1 then
TotalSize_Page=TotalSize_Page+theFile.Size/1024
elseif PageUnit=2 then
TotalSize_Page=TotalSize_Page+theFile.Size/1024/1024
elseif PageUnit=3 then
TotalSize_Page=TotalSize_Page+theFile.Size/1024/1024/1024
end if
if TotalSize_Page>1024 then
TotalSize_Page=TotalSize_Page/1024
PageUnit=PageUnit+1
end if
if PageUnit=1 then
strPageUnit="KB"
elseif PageUnit=2 then
strPageUnit="MB"
elseif PageUnit=3 then
strPageUnit="GB"
end if
end if
Next
TotalSize_Page = Round(TotalSize_Page, 2)
end sub
'-----------------------------
%>
</body>
</html>
<%
'--统计信息 显示文件数 占用 KB-----------
sub showCount(sfilename,totalnumber,maxperpage)
dim n, i,strTemp
if totalnumber mod maxperpage=0 then
n= totalnumber \ maxperpage
else
n= totalnumber \ maxperpage+1
end if
strTemp= "<table align='center'><form name='showpages' method='Post' action='" & sfilename & "'><tr><td>"
strTemp=strTemp & "共 <b>" & totalnumber & "</b> 个文件，占用 <b>" & TotalSize & "</b> " & strTotalUnit & " "
sfilename=JoinChar(sfilename)
if CurrentPage<2 then
strTemp=strTemp & "首页 上一页 "
else
strTemp=strTemp & "<a href='" & sfilename & "page=1'>首页</a> "
strTemp=strTemp & "<a href='" & sfilename & "page=" & (CurrentPage-1) & "'>上一页</a> "
end if
if n-currentpage<1 then
strTemp=strTemp & "下一页 尾页"
else
strTemp=strTemp & "<a href='" & sfilename & "page=" & (CurrentPage+1) & "' target='_self'>下一页</a> "
strTemp=strTemp & "<a href='" & sfilename & "page=" & n & "'>尾页</a>"
end if
strTemp=strTemp & " 页次：<strong><font color=red>" & CurrentPage & "</font>/" & n & "</strong>页 "
strTemp=strTemp & " <b>" & maxperpage & "</b>" & "个文件/页"
strTemp=strTemp & " 转到：<select name='page' size='1' onchange='javascript:submit()'>"
for i = 1 to n
strTemp=strTemp & "<option value='" & i & "'"
if cint(CurrentPage)=cint(i) then strTemp=strTemp & " selected "
strTemp=strTemp & ">第" & i & "页</option>"
next
strTemp=strTemp & "</select>"
strTemp=strTemp & "</td></tr></form></table>"
response.write strTemp
end sub
'**************************************************
'函数名：JoinChar
'作 用：向地址中加入 ? 或 &
'参 数：strUrl ----网址
'返回值：加了 ? 或 & 的网址
'**************************************************
function JoinChar(strUrl)
if strUrl="" then
JoinChar=""
exit function
end if
if InStr(strUrl,"?")<len(strUrl) then
if InStr(strUrl,"?")>=0 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
'**************************************************
'函数名：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
%>