无组件上传文件到文件夹，不用到数据库

jeetliang 2007-12-19 09:57:56
网上看了很多，但是没法实现，请大家帮忙！

我试了这个http://blog.csdn.net/xiaolei1982/archive/2007/08/17/1748243.aspx
可上面说得很清楚，可提交时就是跳到uploadfile.asp
报错
HTTP 500 - 内部服务器错误
Internet Explorer
...全文
153 7 打赏 收藏 转发到动态 举报
写回复
用AI写文章
7 条回复
切换为时间正序
请发表友善的回复…
发表回复
jeetliang 2008-01-25
  • 打赏
  • 举报
 回复
大家可不可说清楚点啊！文件名，然后再代码
xiaolei1982 2007-12-20
  • 打赏
  • 举报
 回复
把你的浏览器关掉后重新测试
xiaolei1982 2007-12-20
  • 打赏
  • 举报
 回复 
<HTML>

 <HEAD>

  <TITLE> 图片和文本一同上传 </TITLE>

 </HEAD>

<style>

body {font-size:12px;}

</style>

 <BODY>

    <form action="7.asp" method="post" enctype="multipart/form-data" name="form1">

 文件路径<input type="file" name="filepath"><br>

   标题<input type="text" name="filename"><br>

 <input type="submit" value="提交">

 </form>

 </BODY>

</HTML>





<%

  Dim stream1,stream2,istart,iend,filename

  istart=1

  vbEnter=Chr(13)&Chr(10)



if Request.TotalBytes>0 then

set objstream=server.CreateObject("adodb.stream")

objstream.Mode=3

objstream.Type=1

objstream.Open



objstream.Write Request.BinaryRead(Request.TotalBytes)



'response.BinaryWrite(objstream.Read)

'response.End()

path=getvalue("filepath",false,"pic/")     'pic为当前目录下一个文件夹名,也可以改成../pic,即上层目录中的pic文件夹

name=getvalue("filename",true,"")

response.write "文件名："&path&"  标题:"&name

'response.End()



End if





function getvalue(fstr,foro,paths)'fstr为接收的名称，foro布尔false为文件上传,true 为普通字段，path为上传文件存放路径

   if foro then

    getvalue=""

    istart=instring(istart,fstr)



    istart=istart+len(fstr)+5

    iend=instring(istart,vbenter+"-----------------------------")

    if istart>5+len(fstr) then

    getvalue=substring(istart,iend-istart)

  

    else

    getvalue=""

    end if

    else

 

    istart=instring(istart,fstr)

    istart=istart+len(fstr)+13

    iend=instring(istart,vbenter)-1

   

    filename=substring(istart,iend-istart)

    filename=getfilename(filename)

 'CheckFileExt(fstr)'''''''''''''''''''''''''''''''''''''''''''''''''''''''

    istart=instring(iend,vbenter+vbenter)+3

    iend=instring(istart,vbenter+"-----------------------------")

    filestart=istart

    filesize=iend-istart-1

    objstream.position=filestart

    Set sf = Server.CreateObject("ADODB.Stream")

    sf.Mode=3

    sf.Type=1

    sf.Open

	

    objstream.copyto sf,FileSize

   

     if filename<>"" then

    Set rf = Server.CreateObject("Scripting.FileSystemObject")

    i=0

    fn=filename

    while rf.FileExists(server.mappath(paths+fn))



      fn=cstr(i)+filename

      i=i+1

      wend

    filename=fn

    sf.SaveToFile server.mappath(paths+filename),2

    end if

    getvalue=filename

    end if  

end function



Private function GetFileName(FullPath)

  If FullPath <> "" Then

   GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1)

  Else

   GetFileName = ""

  End If

End  function



Function inString(theStart,varStr)

dim i,j,bt,theLen,str

InString=0

Str=toByte(varStr)

theLen=LenB(Str)

for i=theStart to objStream.Size-theLen

'response.Write(theStart)

'response.End()

   if i>objstream.size then exit Function

  

   objstream.Position=i-1

   if AscB(objstream.Read(1))=AscB(midB(Str,1)) then

    InString=i

    for j=2 to theLen

      if objstream.EOS then 

        inString=0

        Exit for

      end if

      if AscB(objstream.Read(1))<>AscB(MidB(Str,j,1)) then

        InString=0

        Exit For

      end if

    next

    if InString<>0 then Exit Function

   end if

next

End Function





function toByte(Str)

   dim i,iCode,c,iLow,iHigh

   toByte=""

   For i=1 To Len(Str)

   c=mid(Str,i,1)

   iCode =Asc(c)

   If iCode<0 Then iCode = iCode + 65535

   If iCode>255 Then

     iLow = Left(Hex(Asc(c)),2)

     iHigh =Right(Hex(Asc(c)),2)

     toByte = toByte & chrB("&H"&iLow) & chrB("&H"&iHigh)

   Else

     toByte = toByte & chrB(AscB(c))

   End If

   Next

End function



Function subString(theStart,theLen)

dim i,c,stemp

objStream.Position=theStart-1

stemp=""

for i=1 to theLen

   if objStream.EOS then Exit for

   c=ascB(objStream.Read(1))

   If c > 127 Then

    if objStream.EOS then Exit for

    stemp=stemp&Chr(AscW(ChrB(AscB(objStream.Read(1)))&ChrB(c)))

    i=i+1

   else

    stemp=stemp&Chr(c)

   End If

Next

subString=stemp

End function

%>
braveboy 2007-12-20
  • 打赏
  • 举报
 回复
把你的那个IE显示错误给打开吧选项
工具->选项->高级,在这里面找到那个"显示友好的HTTP错误信息"前面的勾选去掉
就可以看到错误提示
jeetliang 2007-12-20
  • 打赏
  • 举报
 回复
还是不行！
www_7di_net 2007-12-20
  • 打赏
  • 举报
 回复 


<!--#include file="sofia_UpLoad.inc"-->

<%

action = Request.QueryString("action")

Select Case action

	Case "up"

		Call up()

	Case else

		Call up()

End Select

'-----------------------------

Sub main()

	Response.Write "<form name='form1' method='post' action='?action=up' enctype='multipart/form-data'>"&vbnewline

	Response.Write "<input type='text' value='abc' name='text1'><input type=file name='fdfdfd'>"&vbnewline

	Response.Write "<input type=submit name='submit' value='提交'></form>"&vbnewline

End Sub

'-----------------------------

Sub up()

	Set upload=new SoFia_UpLoad

	Set file=upload.file("fdfdfd")

	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	 

		Response.Write  "<br>文件扩展名:"&file.ExtName

	End If

	Set file=nothing

	Set upload=nothing

	Call main()

End Sub


sofia_UpLoad.inc的代码


<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>

'----------------------------------

'为了确保安全型,该上传类任何情况下都不允许上传asp;asa;php;jsp;js;xml;html;asps文件

'Design by Sofia (See7di@Gmail.com;www.7di.net)

Dim Data_sofia



Class sofia_UpLoad

  

Dim objForm,objFile



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

	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_sofia = Server.CreateObject("adodb.stream")

	Data_sofia.Type = 1

	Data_sofia.Mode =3

	Data_sofia.Open

	If Request.TotalBytes/1024>200 Then

		Response.Write "上传文件超出了200K限制！"

		Response.End()

	End If

	Data_sofia.Write  Request.BinaryRead(Request.TotalBytes)

	Data_sofia.Position=0

	RequestData =Data_sofia.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_sofia.Position = IformStart

		Data_sofia.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)

			'Response.Write IfindStart

			theFile.FilePath=GetFilePath(sFileName)

			theFile.ExtName=GetExtName(sFileName)

			'取得文件类型

			IfindStart = InStr(IfindEnd,sInfo,"Content-Type: ",1)+14

			IfindEnd = InStr(IfindStart,sInfo,vbCr)

			theFile.FileType =Mid (sinfo,IfindStart,IfindEnd-IfindStart)

			If theFile.FileType="text/plain" Or theFile.FileType="text/html" Or theFile.FileType="application/x-js" Or theFile.FileType="text/xml" Or theFile.FileType="application/x-php" Or theFile.ExtName="asp" Or theFile.ExtName="asa" Or theFile.ExtName="js" Or theFile.ExtName="aspx" Then

				Response.Write "请不要上传此类文件！"

				Response.End()

			End If

			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_sofia.Position = iInfoEnd 

			Data_sofia.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_sofia.Close

		Set Data_sofia =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



Private Function GetExtName(FullPath)

	If FullPath <> "" Then

		GetExtName = mid(mid(FullPath,InStrRev(FullPath, "\")+1),InStrRev(mid(FullPath,InStrRev(FullPath, "\")+1), ".")+1)

	Else

		GetExtName = ""

	End If

End Function

End Class



Class FileInfo

	Dim FormName,FileName,FilePath,FileSize,FileType,FileStart,ExtName

	Private Sub Class_Initialize 

		FileName = ""

		FilePath = ""

		FileSize = 0

		FileStart= 0

		FormName = ""

		FileType = ""

		ExtName = ""

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_sofia.position=FileStart

	Data_sofia.copyto dr,FileSize

	dr.SaveToFile FullPath,2

	dr.Close

	Set dr=nothing 

	SaveAs=false

End Function

End Class

</SCRIPT>
xiaolei1982 2007-12-19
  • 打赏
  • 举报
 回复 
set objstream=server.CreateObject("adodb.stream")

objstream.Mode=3

objstream.Type=1

objstream.Open



objstream.Write Request.BinaryRead(Request.TotalBytes)

objstream.Position=0//把这个加上，其次是必须要建立一个pic文件夹
Asp无组件上传,表单值和文件可以分别保存到数据库和文件夹
Asp无组件上传,表单值和文件可以分别保存到数据库和文件夹
ASP上传图片到指定文件夹，并保存图片信息到数据库
ASP上传图片到指定文件夹，并保存图片信息到数据库，实现图片上传功能。
Qt数据库高级编程、SQLServer、MySQL、SQLite
Qt 5 框架是高效的跨平台C++框架,易扩展，组件丰富、允许真正地组件编程，既可以开发桌面应用程序，也可用于控制台工具、上位机软件、和高性能服务器的开发，目前国内Qt高级开发工程师的待遇也一直居高不下！...
艾恩ASP_文件上传组件anupload
艾恩ASP无组件上传组件，不敢夸口说多完美，但能实现基本的功能.包括提取表单数据、上传到不同文件夹、保存 到数据库(上传和保存表单可同时进行)、限制上传扩展名、限制上传大小、选择文件保存类型(原文件名和时间...
无组件上传代码
用户可以设置上传文件数量，（代码里限制上传文件个数不超过三个，自己可以修改）。可以上传多种格式文件，文件保存到指定文件夹，并将信息写入数据库。
ASP

28,391

社区成员

357,060

社区内容

发帖
与我相关
我的任务
社区描述
ASP即Active Server Pages，是Microsoft公司开发的服务器端脚本环境。
社区管理员
  • ASP
  • 无·法
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章