ASP无组件上传类的应用实例

发表于:2007-06-30来源:作者:点击数: 标签:
‘’‘’‘’‘’‘’‘’-------- upload.htm ------------- script language=" java script" function checkFile(myForm) { if(myForm.File1.value==‘’‘’) return false; myForm.submit(); } /script form method="POST" name="upl" action="fjupload.

‘’‘’‘’‘’‘’‘’-------- 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
%>

原文转自:http://www.ltesting.net