ASP+access实现文件上传到文件夹，路径存入数据库 - 编程论坛

#2

ctr0072012-06-12 15:06

回复楼主 ctr007

望高手不吝赐教

#3

ysf01812012-06-12 15:42

程序代码：

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

zhujian.asp

[ 本帖最后由 ysf0181 于 2012-6-12 15:45 编辑 ]

#4

ysf01812012-06-12 15:44

#5

ysf01812012-06-12 15:45

<%'OPTION EXPLICIT%>
<%Server.ScriptTimeOut=5000%>



<body topmargin="0" leftmargin="0">
<%

dim upload,file,formName,formPath,iCount,fname,ffname,zj
set upload=new upload_5xsoft ''建立上传对象
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数据
  next
  for each formName in upload.objFile ''列出所有上传了的文件
      set file=upload.file(formName)  ''生成一个文件对象
      'response.write file.FileSize
      'response.end
      wendaxiao = 5
      if int(file.FileSize) > int(1024*1024*wendaxiao) then
         response.write"<script>alert('对不起,文件超过  "&wendaxiao&" ，请将文件压缩小于 "&wendaxiao&" M，在上传!');</script>"
         response.write "<meta http-equiv=refresh content='0;url=upfile_beike.htm'>"
         response.end
      end if
      if right(file.FileName,3)<>"jpg" and right(file.FileName,3)<>"doc" and right(file.FileName,3)<>"rar" and right(file.FileName,3)<>"xls" then
         response.write"<script>alert('对不起,您上传的文件类型不允许!');/script>"
         response.write "<meta http-equiv=refresh content='0;url=upfile_beike.htm'>"
         response.end
      end if
      if len(file.FileName)>25  then
         response.write"<script>alert('对不起,您的文件名太长了，请小于 25个字!');</script>"
         response.write "<meta http-equiv=refresh content='0;url=upfile_beike.htm'>"
         response.end
      end if
      if file.FileSize>0 then         ''如果 FileSize > 0 说明有文件数据
         file.SaveAs Server.mappath(formPath&replace(file.FileName," ",""))   ''保存文件
         fname=formPath&File.FileName
         ffname=File.FileName
         zj=file.FileSize
         iCount=iCount+1
      end if
      set file=nothing
   next
   set upload=nothing  ''删除此对象

   CheckFileContent11(fname) '对上传文件的检查

   Htmend iCount&""
sub HtmEnd(Msg)
    set upload=nothing
    response.write " 文件上传成功!<script>parent.document.form1.fname.value='"&fname&"';</script>"
    response.write "<script>parent.HtmlEdit.focus();</script>"
    response.end
end sub

function CheckFileContent11(filebb) '对文件代码的判断，对上传的文件的删除。。。。
   Set objFSO=Server.CreateObject("Scripting.FileSystemObject")
   If objFSO.FileExists(Server.MapPath(filebb)) Then
      Set objTS=objFSO.OpenTextFile(Server.MapPath(filebb),1) '以文本文件方式读取文件
      strText=lcase(objTS.ReadAll) '全文读取，并转换为小写
      objTS.Close
      ComStr="cookie|.getfolder|.createfolder|.deletefolder|.createdirectory|.deletedirectory" '禁止字符
      ComStr=ComStr&"|.saveas|wscript.shell|script.encode|folderfath|session" '禁止字符
      ComStr=ComStr&"|function|sub|then|end if|else|delete|update|set|server" '禁止字符
      strArray=split(ComStr,"|")
      for i=0 to ubound(strArray)
          if instr(strText,strArray(i))<>0 then
             objFSO.DeleteFile Server.MapPath(filebb),True '删除文件
             response.write "<script>alert('非法文件，禁止上传')</script>"
             response.write "<script>winclose(2);</script>"
             response.end
          end if
     next
     Set objFSO=nothing
   else
     response.write"该文件不存在"
   end if
end function   '对文件代码的判断，对上传的文件的删除。。。。

%>

#6

ctr0072012-06-12 15:54

回复 5楼 ysf0181

不懂诶，你能做一个完整能运行的实例打包一下吗？

#7

ysf01812012-06-12 16:03

唉，基础差了。你多补补吧。或者去直接下个源码，你自己调试看看，不懂的话，你改其他一样不懂的。你要花点时间学习。很多下asp源码的网站，baidu.com吧。

上面保存文件名，

#8

a4389203762012-06-14 05:17

新手来学习，求支持、求指教

#9

邓守恒2012-06-17 11:30

溜达一下！

#10

jyhwcec2021-04-26 14:10

已经比较完整了