📄 uploadfile.asp
字号:
<!--#include FILE="../../Inc/Conn.asp"-->
<!--#include file="../../Inc/Cls.Common.asp"-->
<!--#include file="../Cook.asp"-->
<%
Call FlagU()
Response.Buffer = True
Response.Expires = -1
Response.ExpiresAbsolute = Now() - 1
Response.Expires = 0
Response.CacheControl = "no-cache"
%>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>文件管理</title>
<base target="_self">
<style>
BODY,td,div,table{FONT-SIZE: 9pt;line-height:150%;word-break:break-all;}
A {COLOR: #000000; TEXT-DECORATION: None}
A:link {COLOR: #000000; TEXT-DECORATION: None}
A:visited{COLOR: #000000; TEXT-DECORATION: None}
A:hover {COLOR: #000000; TEXT-DECORATION: None}
A:active {TEXT-DECORATION: none}
body{background:menu;margin:0;border:0}
.div {background:#ffffff;FONT-SIZE: 12px;BORDER-Top: #333333 1px solid;BORDER-Left: #333333 1px solid;BORDER-Bottom: #FFFFFF 1px solid;BORDER-Right: #FFFFFF 1px solid}
</style>
<script>
var tID="";
function show(spath,filenum,src,str,ID,aa,bb,cc,dd){
s.innerHTML="<Img src="+src+" width=190 onload=\'DrawImage(this, 190, 250);\'>";
if(ID!=tID){
if (tID!=""){
document.getElementById(tID).style.backgroundColor="";
document.getElementById(tID).style.color="#000000";
}
document.getElementById(ID).style.backgroundColor="#0A246A";
document.getElementById(ID).style.color="#FFFFFF";
tID=ID;
}
sf.innerHTML = "名称："+aa+"<br>类型："+bb+"文件<br>大小："+cc+"<br>最后更新："+dd;
formpic.formpicpath.value=str;
formpic.smallformpicpath.value=spath;
}
//设定图片显示尺寸
var flag=false;
function DrawImage(ImgD,w,h){
var image=new Image();
image.src=ImgD.src;
if(image.width>0 && image.height>0){
flag=true;
if(image.width/image.height>= w/h){
if(image.width>w){
ImgD.width=w;
ImgD.height=(image.height*w)/image.width;
}else{
ImgD.width=image.width;
ImgD.height=image.height;
}
}
else{
if(image.height>h){
ImgD.height=h;
ImgD.width=(image.width*h)/image.height;
}else{
ImgD.width=image.width;
ImgD.height=image.height;
}
}
}
}
</script>
</head>
<body>
<%
'UploadFile.asp?Type=1&User=1
'uType 1分类信息，2文章，3店铺图，4店铺视频，5认证，6头像，7广告，8商品 ,9优惠券
'uUser 1后台、2代理 3用户
Call WM_Content
Sub WM_Content()
Dim UploadFiles
Dim sCurrDir, sDir
Dim sFileName, sMapFileName, oFolder, oFiles, oFile
Dim sFolderName, sMapFolderName
Dim oUploadFolder, oUploadFiles, oUploadFile
Dim sCurrPage, nCurrPage, nFileNum, nPageNum, nPageSize
Dim oSubFolder
Dim sPicName,sF,sPageNum,sFilter,sPic
sPageNum = 999
Dim uUser,uType
uUser = Int(Request("User"))
uType = Int(Request("Type"))
sCurrDir = WR_Setting(3)&WR_UpLoad(0)&"/"&GetDir(uType)&"/" '设定打开目录
Call WRMPS.FsoBegin()
Call WRMPS.CreFolder(sCurrDir) '检测目录是否存在，否则生成
sDir = Trim(Request("dir"))
sDir = WRMPS.GetReplace(sDir,"../","")
sDir = WRMPS.GetReplace(sDir,"./","")
If sDir <> "" Then
If WRMPS.FsoIsTrue("Dir",sCurrDir & sDir) = True Then
sCurrDir = sCurrDir & sDir & "/"
Else
sDir = ""
End If
End If
' 显示文件列表
If sCurrDir = "" Then Exit Sub
sCurrPage = Trim(Request("page"))
If sCurrPage = "" Or Not IsNumeric(sCurrPage) Then
nCurrPage = 1
Else
nCurrPage = CLng(sCurrPage)
End If
Response.Write "<table width=500 height=350 border=0 align=center cellpadding=0 cellspacing=0>" & vbCrLf
Response.Write "<tr><td class=div width=295 valign=top>" & vbCrLf
Response.Write "<div style=""width:295px;height:100%;overflow-y:scroll;overflow-x:hidden""><table width=100% border=0 align=center cellpadding=0 cellspacing=1>" & vbCrLf
Set oUploadFolder = Fso.GetFolder(Server.MapPath(sCurrDir))
If Err.Number > 0 Then
Response.Write "<tr><td>无效的目录</td></tr></table>" & vbCrLf
Exit Sub
End If
sF = 0
If sDir <> "" Then
sF = sF + 1
Response.write "<tr><td><a title='返回上一级文件夹' href='?User="&uUser&"&Type="&uType&"&dir="
If InStrRev(sDir, "/") > 1 Then Response.Write Left(sDir, InStrRev(sDir, "/") - 1)
Response.Write "' target=''><img border=0 src='../../Images/Ext/folderback.gif' align=absmiddle> ..</a></td>"
Response.Write "<td align=right></td></tr>" & vbCrLf
End If
For Each oSubFolder In oUploadFolder.SubFolders
sF = sF + 1
Response.write "<tr><td><a title='打开此文件夹' href=""?User="&uUser&"&Type="&uType&"&dir="
If sDir <> "" Then Response.Write sDir & "/"
Response.Write oSubFolder.Name & """ target=''><img border=0 src='../../Images/Ext/folder.gif' align=absmiddle> " & oSubFolder.Name & "</a></td>"
Response.Write "<td align=right></td></tr>" & vbCrLf
Next
Set oUploadFiles = oUploadFolder.Files
nPageSize = sPageNum - sF
nFileNum = oUploadFiles.Count
nPageNum = Int(nFileNum / nPageSize)
If nFileNum Mod nPageSize > 0 Then
nPageNum = nPageNum + 1
End If
If nCurrPage > nPageNum Then
nCurrPage = 1
End If
Dim i,n,SPicPath
i = 0
n = 0
If nFileNum > 0 Then
For Each oUploadFile In oUploadFiles
i = i + 1
If i > (nCurrPage - 1) * nPageSize And i <= nCurrPage * nPageSize Then
sF = sF + 1
sFilter = "":sPic = "":sFileName = oUploadFile.Name
sFilter = Lcase(Split(sCurrDir & sFileName,".")(UBound(Split(sCurrDir & sFileName,"."))))
If sFilter = "jpg" Or sFilter = "gif" Or sFilter = "jpeg" Or sFilter = "bmp" Or sFilter = "png" Or sFilter = "ico" Then sPic = sCurrDir & sFileName Else sPic = sExt(sCurrDir & sFileName)
Response.write "<tr><td><a style='cursor:hand'"
Select Case uType
Case 6
Response.write " ondblclick=""dialogArguments.parent.upother('"&sCurrDir & sFileName&"');window.close();"""
Case 7
Response.write " ondblclick=""dialogArguments.parent.upad('"&sCurrDir & sFileName&"');window.close();"""
Case 8
SPicPath = sCurrDir & sFileName
SPicPath = Replace(SPicPath,split(SPicPath,"/")(UBound(split(SPicPath,"/"))),"S/"&split(SPicPath,"/")(UBound(split(SPicPath,"/"))))
If WRMPS.FsoIsTrue("File",SPicPath) = False Then SPicPath = sCurrDir & sFileName
Response.write " ondblclick=""dialogArguments.parent.upshop('"&SPicPath&"');window.close();"""
Case 9
SPicPath = sCurrDir & sFileName
SPicPath = Replace(SPicPath,split(SPicPath,"/")(UBound(split(SPicPath,"/"))),"S/"&split(SPicPath,"/")(UBound(split(SPicPath,"/"))))
If WRMPS.FsoIsTrue("File",SPicPath) = False Then SPicPath = sCurrDir & sFileName
Response.write " ondblclick=""dialogArguments.parent.upcou('"&SPicPath&"','"&sCurrDir & sFileName&"');window.close();"""
Case Else
SPicPath = sCurrDir & sFileName
SPicPath = Replace(SPicPath,split(SPicPath,"/")(UBound(split(SPicPath,"/"))),"S/"&split(SPicPath,"/")(UBound(split(SPicPath,"/"))))
If WRMPS.FsoIsTrue("File",SPicPath) = False Then SPicPath = sCurrDir & sFileName
Response.write " ondblclick=""dialogArguments.parent.upback('"&SPicPath&"','"&sCurrDir & sFileName&"');window.close();"""
End Select
Response.write " onclick=""show('"&SPicPath&"',"&nFileNum&",'"&sPic&"','" & sCurrDir & sFileName & "','a_"&n&"','"&sFileName&"','"&UCase(Mid(sFileName, InStrRev(sFileName, ".") + 1)) &"','"&Showsize(oUploadFile.size)&"','"&oUploadFile.DateCreated&"')"" target=''"
Response.write " title='名称："&sFileName&vbCrLf&"类型："&UCase(Mid(sFileName, InStrRev(sFileName, ".") + 1)) &" 文件"&vbCrLf&"大小："&Showsize(oUploadFile.size)&vbCrLf&"最后更新："&oUploadFile.DateCreated&"'>"
Response.Write "<img border=0 src='"&sExt(sCurrDir & sFileName)&"' align=absmiddle> <span id=a_"&n&">" &sFileName& "</span></a></td>"
Response.Write "<td align=right>"&Showsize(oUploadFile.size)&"</td></tr>" & vbCrLf
n = n + 1
ElseIf i > nCurrPage * nPageSize Then
Exit For
End If
Next
End If
Response.Write "</tr>" & vbCrLf
Set oUploadFolder = Nothing
Set oUploadFiles = Nothing
Call WRMPS.FsoEnd()
URLParameter = "User="&uUser&"&Type="&uType&"&dir=" & sDir
Response.Write "</table>" & vbCrLf
Response.write "<table width='100%'><tr><td align=right>"&GetPicPageList(URLParameter, nPageSize, nFileNum, nCurrPage)&"</td></tr></table></div>"
Response.Write "</td><td width=5></td><td class=div width=200 height=328>" & vbCrLf
Response.Write "<table width='100%' border=0 cellspacing=0 cellpadding=0>" & vbCrLf
Response.Write "<tr><td id=s align=center>预览区</td></tr>" & vbCrLf
Response.Write "<tr><td id=sf style='padding:0 0 0 10px'></td></tr></table>" & vbCrLf
Response.Write "</td></tr>"
Response.Write "<form name='formpic' method='post'>"
Response.Write "<tr><td style='padding:3px 0 0 0' colspan=3><input type='text' name='formpicpath' size=54><input type='hidden' name='smallformpicpath' size=54> "
Select Case uType
Case 6
Response.Write "<input type='button' onclick='dialogArguments.parent.upother(formpicpath.value);window.close();' name='Submit' value='确 定'>"
Case 7
Response.Write "<input type='button' onclick='dialogArguments.parent.upad(formpicpath.value);window.close();' name='Submit' value='确 定'>"
Case 8
Response.Write "<input type='button' onclick='dialogArguments.parent.upshop(smallformpicpath.value);window.close();' name='Submit' value='确 定'>"
Case 9
Response.Write "<input type='button' onclick='dialogArguments.parent.upcou(smallformpicpath.value,formpicpath.value);window.close();' name='Submit' value='确 定'>"
Case Else
Response.Write "<input type='button' onclick='dialogArguments.parent.upback(smallformpicpath.value,formpicpath.value);window.close();' name='Submit' value='确 定'>"
End Select
Response.Write " <input type='button' onclick='window.close();' name='Submit' value='关 闭'></td></tr>"
Response.Write "</form>"
Response.Write "</table>" & vbCrLf
End Sub
Function Showsize(Show)
Dim ShowS
ShowS = Show & " Byte"
If Show > 1024 Then
Show = (Show / 1024)
ShowS = FormatNumber(Show, 2) & " KB"
End If
If Show > 1024 Then
Show = (Show / 1024)
ShowS = FormatNumber(Show, 2) & " MB"
End If
If Show > 1024 Then
Show = (Show / 1024)
ShowS = FormatNumber(Show, 2) & " GB"
End If
Showsize = ShowS
End Function
Function sExt(str)
Dim Z_sExt
Z_sExt = UCase(Mid(str, InStrRev(str, ".") + 1))
Select Case Z_sExt
Case "TXT"
sExt = "../../Images/Ext/txt.gif"
Case "CHM", "HLP"
sExt = "../../Images/Ext/hlp.gif"
Case "DOC"
sExt = "../../Images/Ext/doc.gif"
Case "PDF"
sExt = "../../Images/Ext/pdf.gif"
Case "MDB"
sExt = "../../Images/Ext/mdb.gif"
Case "GIF"
sExt = "../../Images/Ext/gif.gif"
Case "PNG"
sExt = "../../Images/Ext/pic.gif"
Case "BMP"
sExt = "../../Images/Ext/bmp.gif"
Case "JPG","JPEG"
sExt = "../../Images/Ext/jpg.gif"
Case "SWF"
sExt = "../../Images/Ext/swf.gif"
Case "ASP", "JSP", "JS", "PHP", "PHP3", "PHP4", "ASPX"
sExt = "../../Images/Ext/code.gif"
Case "HTM","HTML","SHTML","DHTML"
sExt = "../../Images/Ext/htm.gif"
Case "RAR"
sExt = "../../Images/Ext/rar.gif"
Case "ZIP"
sExt = "../../Images/Ext/zip.gif"
Case "EXE"
sExt = "../../Images/Ext/exe.gif"
Case "XLS"
sExt = "../../Images/Ext/xls.gif"
Case "AVI"
sExt = "../../Images/Ext/avi.gif"
Case "RM"
sExt = "../../Images/Ext/rm.gif"
Case "MP3"
sExt = "../../Images/Ext/mp3.gif"
Case "MID","MIDI"
sExt = "../../Images/Ext/mid.gif"
Case "MPG", "MPEG", "ASF","RA","WAV","MP4"
sExt = "../../Images/Ext/mp.gif"
Case Else
sExt = "../../Images/Ext/unknow.gif"
End Select
End Function
Function GetDir(uType)
Select Case Int(uType)
Case 1
GetDir = WR_UpLoad(2)
Case 2
GetDir = WR_UpLoad(5)
Case 3
GetDir = WR_UpLoad(8)
Case 4
GetDir = WR_UpLoad(11)
Case 5
GetDir = WR_UpLoad(14)
Case 6
GetDir = WR_UpLoad(17)
Case 7
GetDir = WR_UpLoad(38)
Case 8
GetDir = WR_UpLoad(48)
Case 9
GetDir = WR_UpLoad(51)
End Select
End Function
'=====================================
'通用分页 GetPicPageList
'URLParameter 控制参数
'PageValue:每页显示记录数
'RetCount:总记录数
'CurrentPage:当前页数
'=====================================
Function GetPicPageList(URLParameter,PageValue,RetCount,CurrentPage)
Dim PageContent,PageName,URLP
PageValue=Int(PageValue)
If RetCount="" Then RetCount = 0
RetCount=Int(RetCount)
If CurrentPage="" Then CurrentPage=0
CurrentPage=Int(CurrentPage)
If RetCount > 0 Then
If (RetCount Mod PageValue) = 0 Then
PagesCount = RetCount \ PageValue
Else
PagesCount = (RetCount \ PageValue)+1
End If
PageName = Request.ServerVariables("url")
If URLParameter <> "" Then URLParameter = "&"&URLParameter
PageContent = PageContent & "<strong>[</strong><font color=red><strong>" & RetCount & "</strong></font>/<font color=red><strong>" & CurrentPage & "</strong></font>/<font color=red><strong>" & PagesCount & "</strong></font><strong>]</strong>" & vbCrLf
If CurrentPage > 1 Then
PageContent = PageContent & "<a href='"&PageName&"?Page=1" & URLParameter & "'><font face='webdings'>9</font></a>"
PageContent = PageContent & " <a href='"&PageName&"?Page=" & CurrentPage-1 & URLParameter & "'><font face='webdings'>7</font></a>"
PageContent = PageContent & " <a href='"&PageName&"?Page=" & CurrentPage-1 & URLParameter & "'><b>[" & CurrentPage-1 & "]</b></a>" & vbCrLf
End If
If PagesCount <> 1 Then
PageContent = PageContent & "<b>[" & CurrentPage & "]</b>" & vbCrLf
End If
If PagesCount-CurrentPage <> 0 Then
PageContent = PageContent & "<a href='"&PageName&"?Page=" & CurrentPage+1 & URLParameter & "'><b>[" & CurrentPage+1 & "]</b></a>"
PageContent = PageContent & " <a href='"&PageName&"?Page=" & CurrentPage+1 & URLParameter & "'><font face='webdings'>8</font></a>"
PageContent = PageContent & " <a href='"&PageName&"?Page=" & PagesCount & URLParameter & "'><font face='webdings'>:</font></a>" & vbCrLf
End If
End If
GetPicPageList = PageContent
End Function
Call ClassEnd()
%>
</body>
</html>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -