asp无组件上传类的应用实例/化境HTTP上传程序

原版
upload_5xsoft.inc 文件内容

<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
dim Data_5xsoft

Class upload_5xsoft
  
dim objForm,objFile,Version

Public function Form(strForm)
       strForm=lcase(strForm)
       if not objForm.exists(strForm) then
         Form=""
       else
         Form=objForm(strForm)
       end if
end function

Public function File(strFile)
       strFile=lcase(strFile)
       if not objFile.exists(strFile) then
         set File=new FileInfo
       else
         set File=objFile(strFile)
       end if
end function

Private Sub Class_Initialize
      dim RequestData,sStart,vbCrlf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,theFile
      dim iFileSize,sFilePath,sFileType,sFormValue,sFileName
      dim iFindStart,iFindEnd
      dim iFormStart,iFormEnd,sFormName
      Version="化境HTTP上传程序 Version 2.0"
      set objForm=Server.CreateObject("Scripting.Dictionary")
      set objFile=Server.CreateObject("Scripting.Dictionary")
      if Request.TotalBytes<1 then Exit Sub
      set tStream = Server.CreateObject("adodb.stream")
      set Data_5xsoft = Server.CreateObject("adodb.stream")
      Data_5xsoft.Type = 1
      Data_5xsoft.Mode =3
      Data_5xsoft.Open
      Data_5xsoft.Write      Request.BinaryRead(Request.TotalBytes)
      Data_5xsoft.Position=0
      RequestData =Data_5xsoft.Read

      iFormStart = 1
      iFormEnd = LenB(RequestData)
      vbCrlf = chrB(13) & chrB(10)
      sStart = MidB(RequestData,1, InStrB(iFormStart,RequestData,vbCrlf)-1)
      iStart = LenB (sStart)
      iFormStart=iFormStart+iStart+1
      while (iFormStart + 10) < iFormEnd
iInfoEnd = InStrB(iFormStart,RequestData,vbCrlf & vbCrlf)+3
tStream.Type = 1
tStream.Mode =3
tStream.Open
Data_5xsoft.Position = iFormStart
Data_5xsoft.CopyTo tStream,iInfoEnd-iFormStart
tStream.Position = 0
tStream.Type = 2
tStream.Charset ="gb2312"
sInfo = tStream.ReadText
tStream.Close
'取得表单项目名称
iFormStart = InStrB(iInfoEnd,RequestData,sStart)
iFindStart = InStr(22,sInfo,"name=""",1)+6
iFindEnd = InStr(iFindStart,sInfo,"""",1)
sFormName = lcase(Mid (sinfo,iFindStart,iFindEnd-iFindStart))
'如果是文件
if InStr (45,sInfo,"filename=""",1) > 0 then
      set theFile=new FileInfo
      '取得文件名
      iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10
      iFindEnd = InStr(iFindStart,sInfo,"""",1)
      sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
      theFile.FileName=getFileName(sFileName)
      theFile.FilePath=getFilePath(sFileName)
      '取得文件类型
      iFindStart = InStr(iFindEnd,sInfo,"Content-Type: ",1)+14
      iFindEnd = InStr(iFindStart,sInfo,vbCr)
      theFile.FileType =Mid (sinfo,iFindStart,iFindEnd-iFindStart)
      theFile.FileStart =iInfoEnd
      theFile.FileSize = iFormStart -iInfoEnd -3
      theFile.FormName=sFormName
      if not objFile.Exists(sFormName) then
        objFile.add sFormName,theFile
      end if
else
'如果是表单项目
      tStream.Type =1
      tStream.Mode =3
      tStream.Open
      Data_5xsoft.Position = iInfoEnd
      Data_5xsoft.CopyTo tStream,iFormStart-iInfoEnd-3
      tStream.Position = 0
      tStream.Type = 2
      tStream.Charset ="gb2312"
             sFormValue = tStream.ReadText
             tStream.Close
      if objForm.Exists(sFormName) then
        objForm(sFormName)=objForm(sFormName)&", "&sFormValue    
      else
        objForm.Add sFormName,sFormValue
      end if
end if
iFormStart=iFormStart+iStart+1
wend
      RequestData=""
      set tStream =nothing
End Sub

Private Sub Class_Terminate  
if Request.TotalBytes>0 then
objForm.RemoveAll
objFile.RemoveAll
set objForm=nothing
set objFile=nothing
Data_5xsoft.Close
set Data_5xsoft =nothing
end if
End Sub
   

Private function GetFilePath(FullPath)
      If FullPath <> "" Then
       GetFilePath = left(FullPath,InStrRev(FullPath, "/"))
      Else
       GetFilePath = ""
      End If
End      function

Private function GetFileName(FullPath)
      If FullPath <> "" Then
       GetFileName = mid(FullPath,InStrRev(FullPath, "/")+1)
      Else
       GetFileName = ""
      End If
End      function
End Class

Class FileInfo
      dim FormName,FileName,FilePath,FileSize,FileType,FileStart
      Private Sub Class_Initialize
        FileName = ""
        FilePath = ""
        FileSize = 0
        FileStart= 0
        FormName = ""
        FileType = ""
      End Sub
  
Public function SaveAs(FullPath)
        dim dr,ErrorChar,i
        SaveAs=true
        if trim(fullpath)="" or FileStart=0 or FileName="" or right(fullpath,1)="/" then exit function
        set dr=CreateObject("Adodb.Stream")
        dr.Mode=3
        dr.Type=1
        dr.Open
        Data_5xsoft.position=FileStart
        Data_5xsoft.copyto dr,FileSize
        dr.SaveToFile FullPath,2
        dr.Close
        set dr=nothing
        SaveAs=false
      end function
      End Class
</SCRIPT>

 

 

+++++++++++++++++++++++++++++++++++++++++++++++++++++++++

原版
upfile.htm

+++++++++++++++++++++++++++++++++++++++++++++++++++
<html>
<head>
<title>化境上传</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<style type="text/css">
<!--
td {       font-size: 9pt}
a {       color: #000000; text-decoration: none}
a:hover {       text-decoration: underline}
.tx {       height: 16px; width: 30px; border-color: black black #000000; border-top-width: 0px; border-right-width: 0px; border-bottom-width: 1px; border-left-width: 0px; font-size: 9pt; background-color: #eeeeee; color: #0000FF}
.bt {       font-size: 9pt; border-top-width: 0px; border-right-width: 0px; border-bottom-width: 0px; border-left-width: 0px; height: 16px; width: 80px; background-color: #eeeeee; cursor: hand}
.tx1 { height: 20px; width: 30px; font-size: 9pt; border: 1px solid; border-color: black black #000000; color: #0000FF}
-->
</style>
</head>

<body bgcolor="#FFFFFF" text="#000000">
<form name="form1" method="post" action="upfile.asp" enctype="multipart/form-data" >
       <table border="1" cellspacing="0" cellpadding="0" bordercolorlight="#000000" bordercolordark="#CCCCCC" width="91" height="23">
         <tr>
           <td align="left" valign="middle" height="18" width="18">&nbsp;</td>
           <td bgcolor="#CCCCCC" align="left" valign="middle" height="18" width="67"> 文件上传</td>
         </tr>
       </table>
       <br>
       <input type="hidden" name="act" value="upload">
       <br>
       <table width="71%" border="1" cellspacing="0" cellpadding="5" align="center" bordercolordark="#CCCCCC" bordercolorlight="#000000">
         <tr bgcolor="#CCCCCC">
           <td height="22" align="left" valign="middle" bgcolor="#CCCCCC">&nbsp;化境编程界文件上传</td>
         </tr>
         <tr align="left" valign="middle" bgcolor="#eeeeee">
           <td bgcolor="#eeeeee" height="92">
             <script language="javascript">
        function setid()
        {
        str='<br>';
        if(!window.form1.upcount.value)
         window.form1.upcount.value=1;
         for(i=1;i<=window.form1.upcount.value;i++)
           str+='文件'+i+':<input type="file" name="file'+i+'" style="width:400" class="tx1"><br><br>';
        window.upid.innerHTML=str+'<br>';
        }
        </script>
             <li> 需要上传的个数
               <input type="text" name="upcount" class="tx" value="1">
               <input type="button" name="Button" class="bt" οnclick="setid();" value="· 设定 ·">
             </li>
        
<br>
             <br>
             <li>上传到:
               <input type="text" name="filepath" class="tx" style="width:350" value="">
             </li>
           </td>
         </tr>
         <tr align="center" valign="middle">
           <td align="left" id="upid" height="122"> 文件1:
             <input type="file" name="file1" style="width:400" class="tx1" value="">
           </td>
         </tr>
         <tr align="center" valign="middle" bgcolor="#eeeeee">
           <td bgcolor="#eeeeee" height="24">
             <input type="submit" name="Submit" value="· 提交 ·" class="bt">
             <input type="reset" name="Submit2" value="· 重执 ·" class="bt">
           </td>
         </tr>
       </table>
</form>
</body>
</html>
<script language="javascript">

setid();
</script>

 

+++++++++++++++++++++++++++++++++++++++++++++++++++

原版
upfile.asp

+++++++++++++++++++++++++++++++++++++++++++++++++++

<%OPTION EXPLICIT%>
<%Server.ScriptTimeOut=5000%>
<!--#include FILE="upload_5xsoft.inc"-->
<html>
<head>
<title>文件上传</title>
</head>
<body>
<br>化境文件上传!<hr size=1 noshadow width=300 align=left><br><br>
<%
dim upload,file,formName,formPath,iCount
set upload=new upload_5xsoft ''建立上传对象

response.write upload.Version&"<br><br>"       ''显示上传类的版本

if upload.form("filepath")="" then        ''得到上传目录
HtmEnd "请输入要上传至的目录!"
set upload=nothing
response.end
else
formPath=upload.form("filepath")
''在目录后加(/)
if right(formPath,1)<>"/" then formPath=formPath&"/"
end if

iCount=0
for each formName in upload.objForm ''列出所有form数据
response.write formName&"="&upload.form(formName)&"<br>"
next

response.write "<br>"
for each formName in upload.objFile ''列出所有上传了的文件
set file=upload.file(formName)       ''生成一个文件对象
if file.FileSize>0 then              ''如果 FileSize > 0 说明有文件数据
       file.SaveAs Server.mappath(formPath&file.FileName)        ''保存文件
       response.write file.FilePath&file.FileName&" ("&file.FileSize&") => "&formPath&File.FileName&" 成功!<br>"
       iCount=iCount+1
end if
set file=nothing
next

set upload=nothing       ''删除此对象
Htmend iCount&" 个文件上传结束!"

sub HtmEnd(Msg)
set upload=nothing
response.write "<br>"&Msg&" [<a href=""javascript:history.back();"">返回</a>]</body>< /html>"
response.end
end sub
%>
</body>
</html>

 

+++++++++++++++++++++++++++++++++++++++++
         文本类型README.TXT
+++++++++++++++++++++++++++++++++++++++++

 

化境ASP无组件上传类 - upload_5xsoft 使用手册 2.0
  
http://www.5xsoft.com/ [ 下载 ]

 

       目 录

1.What's New?

2.关于 upload_5xsoft

3.运行平台与注意事项

4.如何得到表单数据

5.如何得到文件数据

6.类的成员与对象

7.使用示例

       what's new  

1.使用了新的处理方式， 提供的高效的处理方式，上传速度可提高一倍以上,可上传更大的文件。

2.添加了form 方法和file方法，把原来的 form 集和 file改为 objForm 和 objFile,避免了若上传时没有数据会出错的Bug。

3.对多选框的优化，上传同名的多选框时，会自动用 ", " 连接起来。

4.对于表单名，不再区分大小写,使用ASP使用者更习惯。

 

 

       关于 upload_5xsoft

一直以来,由于FileSystemObject的局限,所以ASP最大的难题就是文件上传,大多解决法就是安装

第三方上传组件。可第三方组件有很多问题,有的组件要注册,有的组件要在表单中加上他的版权信息。

还有的就是组件的兼容问题。

        在网上也流传了很多无组件上传的代码,但都是只能上传文本文件，或是只能将文件上传到数据库中。

我这段时间在研究ASP,发现可以不用第三方组件上传任意类型的文件。就写了这个类,给大家一

个方便,整个类放在一个文件中: upload_5xsoft.inc 在 Example 目录下还有一个完整的多文件上传示

例程序,可以直接使用。

申明:源代码是完全开放的,可能随意传播,但请保留其完整性,未经作者同意,不得用于商业。

 

       运行平台与注意事项

a)可直接运行于 Windows2000+IIS 5
NT4 或是 Win98+PWS, 要安装ADO2.6 下载地址：http://www.microsoft.com/data/ :
<!--#include FILE="upload_5xsoft.inc"--> 就行了

b) 在使用文件上传时, 表单 form 要加上 enctype="multipart/form-data" 即:

<form name="form1" method="post" action="" enctype="multipart/form-data">
<input type="text" value="abc" name="text1">
<input type=file name="file">
<input type=submit name="submit" value="提交">
</form>

 

       upload_5xsoft的对象

如定义一个上传对象
<!--#include FILE="upload_5xsoft.inc"-->
<%
set upload=new upload_5xsoft 'upload就是一个对象
%>

upload_5xsoft 对象成员
File 方法，得到文件对象,例如：set file=upload.file("file1")

文件对象成员下面有说明
objFile 文件对象集,(是个dictionary对象)

文件对象成员:
Count 属性,文件表单的个数
FileName 属性,上传文件的名字
FileSize 属性,上传文件的大小(为0是表示没有文件)
FilePath 属性,上传前文件所在的路径
FormName 属性,文件表单的名字
SaveAs 方法,储存上传后文件,有一个参数,路径要为真实路径如:
例子: set file=upload.file("file1") 'file1为表单名

response.write "<br>文件名:"&file.FileName

response.write "<br>文件大小:"&file.FileSize

response.write "<br>文件路径:"&file.FilePath

file.saveAs Server.mappath("/1.jpg")

set file=nothing
Form 方法，获得表单数据,如 Response.Write upload.Form("abc")
objForm 表单数据集,(是个dictionary对象)用来代替 Request.Form
count 属性,表单数
exists 方法,检查是否有指定的表单名
更多的用法可看 vbscript 的dictionary对象帮助
例子:
'得到text1表单的数据,uplaod就是一开始创建的对象

sText=upload.form("text1")  
Version 属性,upload_5xsoft类的版本号,如:

response.write upload.Version

 

       使用示例

1.上传一个jpg文件的示例:

文件1: upload.htm

<html><title>example</title>
<body>
<form name="form1" method="post" action="upload.asp" enctype="multipart/form-data">
<input type=file name="file1">
<input type=submit name="submit" value="提交">
</form>
</body>
</html>

文件2: upload.asp

<html><title>example</title>
<body>
<!--#include FILE="upload_5xsoft.inc"-->
<%
set upload=new upload_5xsoft
set file=upload.file("file1")
response.write upload.form("submit")&"<br>"
if file.fileSize>0 then
file.saveAs Server.mappath("temp.jpg")
response.write "<br>上传文件:"&file.FileName&" => temp.jpg OK!"
response.write "<br>文件大小:"&file.FileSize
end if
set file=nothing
set upload=nothing
%></body>
</html>

2.列表出有文件表单(多文件上传)
<html><title>example</title>
<body>
<!--#include FILE="upload_5xsoft.inc"-->
<%
set upload=new upload_5xsoft

''列出所有form数据
for each formName in upload.objForm
response.write formName&"="&upload.objForm(formName)&"<br>"
next

''列出所有文件
for each formName in upload.objFile
set file=upload.objFile(formName)
if file.FileSize>0 then
       file.SaveAs Server.mappath(file.FileName)
       response.write file.FilePath&file.FileName&" ("&file.FileSize&") => "
       response.write file.FileName&" 成功!<br>"
end if
set file=nothing
next
set upload=nothing
%>

另外的一些应用实例

''''''-------- 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="上传" οnclick="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
%>

另可参考: 其他修改后的无组件上传类