📄 saveupload_adv.asp
字号:
<!--#include FILE="CONST.ASP"-->
<!--#include FILE="inc/chkuser.asp"-->
<!--#include FILE="inc/char.asp"-->
<!--#include FILE="inc/Syschar.asp"-->
<!--#include FILE="inc/htmlhead.asp"-->
<%helpID=10
'response.write strCOMP("abcd123","ABcd123",1)
if not Founduser then call EndProc("<br><li>请先登陆，或你尚未登陆！",1,"")
if chkpost()=false then call EndProc("<br><li>请请不要从外不提交发言！",1,"")
Server.ScriptTimeOut=5000
dim newSize
newSize=0
%>
<body bgcolor="#D4D0c8" topmargin="0" bottommargin="0" leftmargin="0" rightmargin="0" >
<span id="upstats">
<table width="100%%" border="0" cellspacing="0" cellpadding="0">
<tr>
<td height="26" bgcolor="#68BBD2"> </td>
</tr>
<tr>
<td height="35"><br> <img src="pic/upstats.gif" width="21" height="22" border="0"> <font size="4">正在上传...............</font></td>
</tr>
</table>
</span>
<%
Response.Flush()
%>
<!--#include FILE="inc/UpgetInc.asp"-->
<table width='100%' align=center border="0" cellpadding="0" cellspacing="0">
<tr>
<td>
<table border="0" width='100%' align="center" cellpadding="0" cellspacing="0" bgcolor="#D4D0c8">
<tr align="center" valign="middle" bgcolor="#68BBD2">
<td height="26" colspan=3> </td>
</tr>
<tr>
<td height="5" colspan=3 > </td>
</tr>
<tr bgcolor="#D4D0c8">
<td height="24" colspan=3 bordercolorlight="#666666" bordercolordark="#ffffff"><span id=infotitle> ●文件上传结果如下：</span></td>
</tr>
<tr bgcolor=#D4D0c8 bordercolor=#D4D0c8><td colspan=3 height=8></td></tr>
<%
' 0 "adodb.Stream"
' 1 "SoftArtisans.FileUp"
'dim upload_Component
'upload_Component=1
Select CASE upload_Component
CASE 0 Call Ado_upload()
CASE 1 Call SA_upload()
CASE else GetError "没有设置上传组件"
end Select
closedatabase
Sub ChkUseSize()
if useQuota<0 then exit SUB
if (Request.TotalBytes+useSize)>useQuota*1024*1024 then
dim newUseSize:newUseSize=GetFsoSize(GetRootUrl)
dim rs
set rs=Server.CreateObject("ADODB.Recordset")
rs.open "select useSize from [UserList] where UserID="&memberid,conn,1,3
if not rs.eof then
dim tmpArr
tmpArr=split(rs(0),"|")
tmpArr(Qi)=newUseSize
rs(0)=join(tmpArr,"|")
rs.update
end if
rs.close
set rs=nothing
dim Ssize:Ssize=useQuota*1024*1024-newUseSize
'重统计出上传可管理目录的空间配额//多目录的处理有点复杂
if Ssize<0 then Ssize=0
if (Request.TotalBytes+newUseSize)>useQuota*1024*1024 then
Response.Write("<script language=""javascript"">window.upstats.innerHTML=('');</script>")
GetError "<br><li>当前上传为 <font color=#ff0000><b>"&formatnumber(Request.TotalBytes/1024/1024,2,-1)&"</b></font> <b>MB</b>,超出你的空间最大配额<li>你的配额为 <font color=#ff0000><b>"&formatnumber(useQuota,0,-1)&"</b></font> <b>MB</b>,"&_
" 剩余空间为：<font color=#ff0000><b>"&formatnumber(Ssize/1024/1024,2,-1)&"</b></font> <b>MB</b>"
end if
end if
End SUB
SUB SA_upload()
dim upload,file,formName,formPath
dim mMax,m,calcYes,action,calcNo,fileExt
dim ServerIP,FileStrings,Strings,Arr
ServerIP=Request.ServerVariables("SERVER_NAME")
calcYes=0:calcNo=0:mMax=0
set upload=Server.CreateObject("SoftArtisans.FileUp")
'Response.Write "<hr>"
' For Each formName in upload.FormEX
' Response.Write( formName & ":" & upload.Form(formName)&"--"&typename(upload.Form(formName))&"<br>")
' Next
'Response.Write "<hr>"
'upload.Form("file1").SaveAs "d:\www\lfgbox\test\upload2.out" '表单保存
'upload.SaveInVirtual "/test/No.jpg"
'upload.Path = "d:\www\lfgbox\test"
'upload.Form("file1").Save
'response_write upload.Form("filepath"),1
'response_write upload.Form("file1"),1
'response_write upload.FormEX("file1"),1
'response_write "ContentType:"&upload.Form("file1").ContentType,1
'response_write "MimeVersion:"&upload.Form("file1").MimeVersion,1
'response_write "ServerName:"&upload.Form("file1").ServerName,1
'response_write "UserFilename:"&upload.Form("file1").UserFilename,1
'response_write "IsEmpty:"&upload.Form("file1").IsEmpty,1
'response_write "TotalBytes:"&upload.Form("file1").TotalBytes ,1
if upload.Form("filepath")="" then
set upload=nothing
Response.write "<script language=JavaScript>window.upstats.innerHTML=('');</script>"
GetError "<br>上传目的目录不能为空!"
Response.end
else
formPath=upload.Form("filepath")
if right(formPath,1)<>"/" then formPath=formPath&"/"
action=CheckFolder(formpath,1)
if action<>"True" then
Response.write "<script language=JavaScript>window.upstats.innerHTML=('');</script>"
GetError "<br>发生错误! "&action
end if
end if
Call ChkUseSize()
dim NewFileName,NewFilePath,upSize
upSize=0
For each formName in upload.Form
'iF typeName(upload.Form(formName))="ISAFile" then
iF isObject(upload.Form(formName)) then
set file=upload.Form(formName)
dim rlen:rlen=InstrRev(file.UserFilename, "\")
NewFileName = Mid(file.UserFilename, rlen + 1)
NewFilePath= left(file.UserFilename,rlen)
'response_write file.UserFilename,1
'response_write NewFileName,1
'response_write NewFilePath,0
if file.TotalBytes>0 then
action=CheckFile(NewFileName,0,"01")
if action="True" then
upSize=upSize+file.TotalBytes
newSize=newSize+FixSize(formPath&NewFileName,"file","upload",file.TotalBytes)
file.SaveAs Server.mappath(formPath&NewFileName)
Strings="http://"&ServerIP&formPath&NewFileName
Response.write "<tr bgcolor=#D4D0c8 bordercolor=#D4D0c8>"&_
"<td align=right ><nobr> "&_
"<img src=pic/upt.gif width=25 height=16 vspace=0>"&file.TotalBytes&"字节__<font color=#000077>"&NewFilePath&NewFileName&" </font></td>"&_
"<td ><img src=pic/ok.gif width=25 height=16 vspace=0></td>"&_
"<td align=left><font color=#008800>"
Response.write " "&Strings
Response.write " </font></nobr></td></tr>"
calcYes=calcYes+1
mMax=mMax+1
FileStrings=FileStrings+Strings+"|"
else
Response.write "<tr bgcolor=#D4D0c8 bordercolor=#D4D0c8>"&_
"<td align=right ><nobr> "&_
"<img src=pic/upt.gif width=25 height=16 vspace=0>"&file.TotalBytes&"字节__<font color=#000077>"&NewFilePath&NewFileName&" </font></td>"&_
"<td><img src=pic/err.gif width=25 height=16 vspace=0></td><td align=left><font color=#cc0000>"&_
"</font> "&action&"</nobr></td></tr>"
calcNo=calcNo+1
end if
end if
eND iF
next
set file=nothing
set upload=nothing
'if upSize>0 then
' dim newSize
' newSize=Fso.GetFolder(server.mappath(UserPath)).size
Call UpdateUseSize(newSize+useSize)
'end if
'========列表显示加入UBB代码
'========images图像
Response.write "<tr bgcolor=#D4D0c8 bordercolor=#D4D0c8><td colspan=3 height=8></td></tr>"&_
"<tr><td height=24 colspan=3 bordercolorlight=#666666 bordercolordark=#ffffff bgcolor=#D4D0c8> ●加上UBB代码如下：</td>"&_
"</tr>"&_
"<tr bgcolor=#D4D0c8 bordercolor=#D4D0c8><td colspan=3 height=10></td>"&_
"</tr>"
Arr=split(FileStrings,"|")
For m=0 to mMax-1
fileExt=lcase(right(Arr(m),4))
if fileEXT=".gif" or fileEXT=".jpg" or fileEXT=".png" or fileEXT=".bmp" then
Response.write "<tr bgcolor=#D4D0c8 bordercolor=#D4D0c8><td align=left colspan=3><nobr> "
Response.write "<font color=#008800> [img]"&Arr(m)
Response.write "[/img]</font></nobr></td></tr>"
''该句把上传结果写回发贴父级窗口!!! ''
'Response.write "<script>parent.frmAnnounce.Content.value+='[img]http://"&ServerIP&""&formPath&NewFileName&"[/img]'</sc ript>"
end if
next
'========other列表显示其它类
Response.write "<tr bgcolor=#D4D0c8 bordercolor=#D4D0c8><td colspan=3 ><hr width='95%' size=1></td></tr>"
For m=0 to mMax-1
fileExt=lcase(right(Arr(m),4))
if fileEXT<>".gif" and fileEXT<>".jpg" and fileEXT<>".png" and fileEXT<>".bmp" then
Response.write "<tr bgcolor=#D4D0c8 bordercolor=#D4D0c8><td align=left colspan=3><nobr> "
Response.write "<font color=#008800> [url]"&Arr(m)
Response.write "[/url]</font></nobr></td></tr>"
'Response.write "<script>parent.frmAnnounce.Content.value+='[url]http://"&ServerIP&""&formPath&NewFileName&"[/url]'</sc ript>"
end if
next
Response.write "<tr bgcolor=#D4D0c8 bordercolor=#D4D0c8><td colspan=3 height=15></td></tr>"
Response.write "<tr><td height=30 colspan=2> ●正确上传:<font color=#ffff00><b>"&calcYes&"</b></font> ,上传失败:<font color=#ff0000><b>"&calcNo&"</b></font> <input type=button class='bt1' onClick='window.close();' value='关 闭'></td>"
%>
<td align="left"> </td>
</table></td>
</tr>
</table>
<br>
<script language="javascript">
window.upstats.innerHTML=('');
if(window.opener&&window.opener.refreshWindow)
{
window.opener.refreshWindow();
}
</script>
<table width="100%" cellpadding=0 border=0 cellspacing=0 align="center">
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -