asp无组件上传类的应用实例
asp无组件上传类的应用实例
上传类代码见另一篇文章：http://blog.csdn.net/precipitant/archive/2005/12/25/561768.aspx
''''''-------- upload.htm -------------
<script language='javascript'>
function checkFile(myForm)
{
if(myForm.File1.value=='') return false;
myForm.submit();
}
</script>
<form method='POST' name='upl' action='fjupload.asp' enctype='multipart/form-data' >
<input type='file' name='File1' ID='File1'>
<input type='button' name='upfiles' value='上传' onclick='checkFile(document.upl);'>
</form>
''' ------------fjupload.asp -----------------
<!--#include file='../../inc/config.asp'-->
<!--#include file='../../inc/upload.inc'-->
<%
founderr=false
SavePath = Server.MapPath('?????') '存放上传文件的目录
call upload_0() '使用化境无组件上传类
'上传程序
sub upload_0() '使用化境无组件上传类
set upload=new upload_file '建立上传对象
dim msg '存储上传过程中发生的错误信息
dim filecount '存储文件总数
dim upcount '存储上传的文件总数
filecount=0
upcount=0
for each formName in upload.file '列出所有上传了的文件
set file=upload.file(formName) '生成一个文件对象
if(file.filename<>'') then
founderr=false
filecount=filecount +1
set file=upload.file(formName) '生成一个文件对象
randomize
ranNum=int(900*rnd)+100
last_fn=hour(now()) & minute(now()) & second(now()) & ranNum '生成一段随机数附加到文件末尾，以防止文件名冲突
ext_fn=file.fileext '扩展名
filename=SavePath & '\' & file.smallfilename & '_' & last_fn
if ext_fn<>'' then filename=filename & '.' & ext_fn
if fso.FileExists(filename) then
msg=msg & '\r\n' & file.filename & ' 文件已经存在，请更改文件名'
founderr=true
end if
'如果可以上传，就执行上传
if founderr<>true then
file.SaveToFile FileName '保存文件
if(err=0) then
upcount = upcount + 1
msg=msg & '\r\n' & file.filename & '上传成功！'
'如果是rar文件进行解压缩
if(lcase(file.fileext)='rar') then
Call UnCompess(FileName,SavePath) '解压缩
end if
else
msg=msg & '\r\n' & file.filename & '上传失败！'
end if
end if
end if
set file=nothing
next
set fso=nothing
set upload=nothing
'如果上传成功的文件数少于上传的文件数就弹出错误提示
if(filecount>upcount) then
%>
<%response.write msg%>
<% end if
end sub
%>
<%
'如果想实现自动解压,还需要将名为rar.exe和cmd.exe的文件拷贝到inc目录下
'如果是rar文件，进行解压缩
'fname: rar文件
'fpath: 解压后文件存储路径
sub UnCompess(fname,fpath)
if(fpath='' or fname='') then exit sub
dim ylj,ywj,Mlpath
Mlpath=Request.ServerVariables('APPL_PHYSICAL_PATH') & '/inc/' '存放RAR.EXE和CMD.EXE的路径
ylj=fpath &'\' '解压文件后所放的路径
ywj=fname '要解压的RAR文件
dim Shell,rarcomm,cmd,RetCode
Set Shell = Server.CreateObject('WScript.Shell')
rarcomm= Mlpath & 'cmd.exe /c '&Mlpath&'rar.exe x -t -o+ -p- '
cmd=rarcomm & ywj & ' ' & ylj
RetCode = Shell.Run(cmd,1, True)
'删除上传的rar文件
set fso2=server.CreateObject('scripting.filesystemobject')
if fso2.FileExists(ywj) then fso2.DeleteFile ywj
set fso2=nothing
end sub
%>
