关于无组件上传文件?

rainbird 2002-05-09 10:23:54
请问哪有无组件文件上传的源代码?是能在win98+pws下运行的。我找过一些,只支持Win2000+iis?


...全文
84 5 打赏 收藏 转发到动态 举报
写回复
用AI写文章
5 条回复
切换为时间正序
请发表友善的回复…
发表回复
zhenhao 2002-05-09
  • 打赏
  • 举报
回复
'********************************** Utilities **********************************
Function BinaryToString(Binary)
Dim I, S
For I=1 to LenB(Binary)
S = S & Chr(AscB(MidB(Binary,I,1)))
Next
BinaryToString = S
End Function

Function StringToBinary(String)
Dim I, B
For I=1 to len(String)
B = B & ChrB(Asc(Mid(String,I,1)))
Next
StringToBinary = B
End Function

'Separates header fields from upload header
Function GetHeadFields(ByVal Head, Content_Disposition, Name, FileName, Content_Type)
Content_Disposition = LTrim(SeparateField(Head, "content-disposition:", ";"))
Name = (SeparateField(Head, "name=", ";")) 'ltrim
If Left(Name, 1) = """" Then Name = Mid(Name, 2, Len(Name) - 2)
FileName = (SeparateField(Head, "filename=", ";")) 'ltrim
If Left(FileName, 1) = """" Then FileName = Mid(FileName, 2, Len(FileName) - 2)
Content_Type = LTrim(SeparateField(Head, "content-type:", ";"))
End Function

'Separets one filed between sStart and sEnd
Function SeparateField(From, ByVal sStart, ByVal sEnd)
Dim PosB, PosE, sFrom
sFrom = LCase(From)
PosB = InStr(sFrom, sStart)
If PosB > 0 Then
PosB = PosB + Len(sStart)
PosE = InStr(PosB, sFrom, sEnd)
If PosE = 0 Then PosE = InStr(PosB, sFrom, vbCrLf)
If PosE = 0 Then PosE = Len(sFrom) + 1
SeparateField = Mid(From, PosB, PosE - PosB)
Else
SeparateField = Empty
End If
End Function

'Separetes file name from the full path of file
Function GetFileName(FullPath)
Dim Pos, PosF
PosF = 0
For Pos = Len(FullPath) To 1 Step -1
Select Case Mid(FullPath, Pos, 1)
Case "/", "\": PosF = Pos + 1: Pos = 0
End Select
Next
If PosF = 0 Then PosF = 1
GetFileName = Mid(FullPath, PosF)
End Function
</SCRIPT>
<SCRIPT RUNAT=SERVER LANGUAGE=JSCRIPT>
//The function creates Field object.
function CreateUploadField(){ return new uf_Init() }
function uf_Init(){
this.Name = null
this.ContentDisposition = null
this.FileName = null
this.FilePath = null
this.ContentType = null
this.Value = null
this.Length = null
}
</SCRIPT>
'upload.asp
<!--#include file="function.inc"-->
<!--#INCLUDE FILE="fupload.inc"-->
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<link rel="stylesheet" type="text/css" href="love.css">
<title>照片上传</title>
</head>
<body>
<form method="post" ENCTYPE="multipart/form-data">
<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
If Request.ServerVariables("REQUEST_METHOD") = "POST" Then 'Request method must be "POST" for get the fields
'************************************************* M
Dim Fields
'on error resume next
'得到关于照片的各种信息
Set Fields = GetUpload()
'Fields("File1").ContentType - 照片文件的文件头格式
response.write Fields("DBFile").FileName
if instr(1,lcase(Fields("DBFile").FileName),".jpg")=0 and instr(1,lcase(Fields("DBFile").FileName),".gif")=0 then
response.write "上传的照片必须是JPG或者Gif格式的照片!"
Response.end
end if
if Fields("DBFile").Length>10000 then
response.write "我们只允许不大于10k的照片上传" & Fields("DBFile").FileName
response.end
end if
If Err = 0 Then
'如果满足要求,则将图片存储到数据库中
if Fields("DBFile").FileName<>"" then
Response.Write DBSaveUpload(Fields)
end if
Else
Response.Write Err.Description
End If
On Error GoTo 0
End If
function DBSaveUpload(Fields)
'将多媒体数据 保存在 SQL Server 中
dim Conn, RS
Set Conn = GetConnection
Set RS = Server.CreateObject("ADODB.Recordset")
Conn.Execute "Delete From LoverPhoto Where ID='test'"
RS.Open "Photo", Conn, 2, 2
RS.AddNew
RS("ID")="test"
RS("PhotoType")=Fields("DBFile").ContentType
RS("Photo").AppendChunk Fields("DBFile").Value
RS.Update
RS.Close
Conn.Close
DBSaveUpload = "<br>这是您上传的照片<b>" & Fields("DBFile").FileName & "</b>, length : <b>" & Fields("DBFile").Length & " B</b>。"
end function

function GetConnection()
Set Conn = Server.CreateObject("ADODB.Connection")
Conn.Open "DSN=song; UID=sa; PWD=; DATABASE=test"
set GetConnection = Conn
end function
</SCRIPT>
<table border=1>
<TR><TD>选择要上传的图片</TD><TD><input type="file" name="DBFile"></TD></TR>
<TR><TD></TD><TD Align=center><input type="submit" Name="Action" value="点这里上传图片"></TD></TR>
</table>
</form>
</body>
</html>
'数据库创建语句 sql.txt
CREATE TABLE Upload (
ID varchar 4 NOT NULL ,
ContentType char(64) NULL ,
Data image NULL
)


zhenhao 2002-05-09
  • 打赏
  • 举报
回复
'解决的问题
1。 文件无组件上传
2. 将 多媒体数据 保存到 sql server 中
'function.inc
<%
'函数聚合
function WriteOption(strType)
Set fso = server.CreateObject("Scripting.FileSystemObject")
Set a = fso.OpenTextFile(server.mappath(strType & ".txt"),1)
ss=a.readall
response.write ss
a.close
set fsp=nothing
end function
%>
'fupload.inc

<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
Dim UploadSizeLimit

'********************************** GetUpload **********************************
'.Name name of the form field (<Input Name="..." Type="File,...">)
'.ContentDisposition = Content-Disposition of the form field
'.FileName = Source file name for <input type=file>
'.ContentType = Content-Type for <input type=file>
'.Value = Binary value of the source field.
'.Length = Len of the binary data field
Function GetUpload()
Dim Result
Set Result = Nothing
If Request.ServerVariables("REQUEST_METHOD") = "POST" Then 'Request method must be "POST"
Dim CT, PosB, Boundary, Length, PosE
CT = Request.ServerVariables("HTTP_Content_Type") 'reads Content-Type header
'response.write CT
'application/x-www-form-urlencoded
If LCase(Left(CT, 19)) = "multipart/form-data" Then 'Content-Type header must be "multipart/form-data"
'This is upload request.
'Get the boundary and length from Content-Type header
PosB = InStr(LCase(CT), "boundary=") 'Finds boundary
If PosB > 0 Then Boundary = Mid(CT, PosB + 9) 'Separetes boundary
Length = CLng(Request.ServerVariables("HTTP_Content_Length")) 'Get Content-Length header
if "" & UploadSizeLimit<>"" then
UploadSizeLimit = clng(UploadSizeLimit)
if Length > UploadSizeLimit then
' on error resume next 'Clears the input buffer
' response.AddHeader "Connection", "Close"
' on error goto 0
Request.BinaryRead(Length)
Err.Raise 2, "GetUpload", "Upload size " & FormatNumber(Length,0) & "B exceeds limit of " & FormatNumber(UploadSizeLimit,0) & "B"
exit function
end if
end if

If Length > 0 And Boundary <> "" Then 'Are there required informations about upload ?
Boundary = "--" & Boundary
Dim Head, Binary
Binary = Request.BinaryRead(Length) 'Reads binary data from client

'Retrieves the upload fields from binary data
Set Result = SeparateFields(Binary, Boundary)
Binary = Empty 'Clear variables
Else
Err.Raise 10, "GetUpload", "Zero length request ."
End If
Else
Err.Raise 11, "GetUpload", "No file sent."
End If
Else
Err.Raise 1, "GetUpload", "Bad request method."
End If
Set GetUpload = Result
End Function

'********************************** SeparateFields **********************************
'This function retrieves the upload fields from binary data and retuns the fields as array
'Binary is safearray of all raw binary data from input.
Function SeparateFields(Binary, Boundary)
Dim PosOpenBoundary, PosCloseBoundary, PosEndOfHeader, isLastBoundary
Dim Fields
Boundary = StringToBinary(Boundary)

PosOpenBoundary = InstrB(Binary, Boundary)
PosCloseBoundary = InstrB(PosOpenBoundary + LenB(Boundary), Binary, Boundary, 0)

Set Fields = CreateObject("Scripting.Dictionary")

Do While (PosOpenBoundary > 0 And PosCloseBoundary > 0 And Not isLastBoundary)
'Header and file/source field data
Dim HeaderContent, FieldContent
'Header fields
Dim Content_Disposition, FormFieldName, SourceFileName, Content_Type
'Helping variables
Dim Field, TwoCharsAfterEndBoundary
'Get end of header
PosEndOfHeader = InstrB(PosOpenBoundary + Len(Boundary), Binary, StringToBinary(vbCrLf + vbCrLf))

'Separates field header
HeaderContent = MidB(Binary, PosOpenBoundary + LenB(Boundary) + 2, PosEndOfHeader - PosOpenBoundary - LenB(Boundary) - 2)

'Separates field content
FieldContent = MidB(Binary, (PosEndOfHeader + 4), PosCloseBoundary - (PosEndOfHeader + 4) - 2)

'Separates header fields from header
GetHeadFields BinaryToString(HeaderContent), Content_Disposition, FormFieldName, SourceFileName, Content_Type

'Create one field and assign parameters
Set Field = CreateUploadField()
Field.Name = FormFieldName
Field.ContentDisposition = Content_Disposition
Field.FilePath = SourceFileName
Field.FileName = GetFileName(SourceFileName)
Field.ContentType = Content_Type
Field.Value = FieldContent
Field.Length = LenB(FieldContent)

Fields.Add FormFieldName, Field

'Is this ending boundary ?
TwoCharsAfterEndBoundary = BinaryToString(MidB(Binary, PosCloseBoundary + LenB(Boundary), 2))
'Binary.Mid(PosCloseBoundary + Len(Boundary), 2).String
isLastBoundary = TwoCharsAfterEndBoundary = "--"
If Not isLastBoundary Then 'This is not ending boundary - go to next form field.
PosOpenBoundary = PosCloseBoundary
PosCloseBoundary = InStrB(PosOpenBoundary + LenB(Boundary), Binary, Boundary )
End If
Loop
Set SeparateFields = Fields
End Function
powerytb 2002-05-09
  • 打赏
  • 举报
回复
用纯ASP代码实现图片上传并存入数据库中

我们用来获取上一个页面传递过来的数据一般是使用Request对象。同样的,我们也可以使用Request对象来获取上传上来的文件数据,使用的方法是Request.BinaryRead()。而我们要从数据库中读出来图片的数据显示到网页上面要用到的方法是:

Request.BinaryWrite()。在我们得到了图片的数据,要保存到数据库中的时候,

不可以直接使用Insert语句对数据库进行*作,而是要使用ADO的

AppendChunk方法,同样的,读出数据库中的图片数据,要使用GetChunk方

法。各个方法的具体语法如下:

* Request.BinaryRead语法:

variant = Request.BinaryRead(count)

参数

variant

返回值保存着从客户端读取到数据。

count

指明要从客户端读取的数据量大小,这个值小于或者等于使用方法

Request.TotalBytes得到的数据量。

* Request.BinaryWrite语法:

Request.BinaryWrite data

参数

data

要写入到客户端浏览器中的数据包。

* Request.TotalBytes语法:

variant = Request.TotalBytes

参数

variant

返回从客户端读取到数据量的字节数。

* AppendChunk语法

将数据追加到大型文本、二进制数据 Field 或 Parameter 对象。

object.AppendChunk Data

参数

object Field 或 Parameter 对象

Data 变体型,包含追加到对象中的数据。

说明

使用 Field 或 Parameter 对象的 AppendChunk 方法可将长二进制或字符数

据填写到对象中。在系统内存有限的情况下,可以使用 AppendChunk 方法对长

整型值进行部分而非全部的*作。

* GetChunk语法

返回大型文本或二进制数据 Field 对象的全部或部分内容 。

variable = field.GetChunk( Size )

返回值

返回变体型。

参数

Size 长整型表达式,等于所要检索的字节或字符数。

说明

使用 Field 对象的 GetChunk 方法检索其部分或全部长二进制或字符数据。

在系统内存有限的情况下,可使用 GetChunk 方法处理部分而非全部的长整型

值。

GetChunk 调用返回的数据将赋给“变量”。如果 Size 大于剩余的数据,则

GetChunk 仅返回剩余的数据而无需用空白填充“变量”。如果字段为空,则

GetChunk 方法返回 Null。

每个后续的 GetChunk 调用将检索从前一次 GetChunk 调用停止处开始的数

据。但是,如果从一个字段检索数据然后在当前记录中设置或读取另一个字段

的值,ADO 将认为已从第一个字段中检索出数据。如果在第一个字段上再次调

用 GetChunk 方法,ADO 将把调用解释为新的 GetChunk *作并从记录的起始

处开始读取。如果其他 Recordset 对象不是首个 Recordset 对象的副本,则

访问其中的字段不会破坏 GetChunk *作。

如果 Field 对象的 Attributes 属性中的 adFldLong 位设置为 True,则可

以对该字段使用 GetChunk 方法。

如果在 Field 对象上使用 Getchunk 方法时没有当前记录,将产生错误 3021

(无当前记录)。

接下来,我们就要来设计我们的数据库了,作为测试我们的数据库结构如

下(Access97):

字段名称    类型    描述

  id    自动编号   主键值

img OLE对象   用来保存图片数据 


对于在MS SQL Server7中,对应的结构如下:

字段名称    类型    描述

  id     int(Identity) 主键值

img   image     用来保存图片数据 


现在开始正式编写我们的纯ASP代码上传部分了,首先,我们有一个提

供给用户的上传界面,可以让用户选择要上传的图片。代码如下

(upload.htm):

<html>

<body>

<center>

   <form name="mainForm" enctype="multipart/form-data"

action="process.asp" method=post>

    <input type=file name=mefile><br>

   <input type=submit name=ok value="OK">

   </form>

</center>

</body>

</html>

注意代码中黑色斜体的部分,一定要在Form中有这个属性,否则,将无

法得到上传上来的数据。

接下来,我们要在process.asp中对从浏览器中获取的数据进行必要的处

理,因为我们在process.asp中获取到的数据不仅仅包含了我们想要的上传上来

的图片的数据,也包含了其他的无用的信息,我们需要剔除冗余数据,并将处

理过的图片数据保存到数据库中,这里我们以Access97为例。具体代

码如下(process.asp):

<%

response.buffer=true

formsize=request.totalbytes

formdata=request.binaryread(formsize)

bncrlf=chrB(13) & chrB(10)

divider=leftB(formdata,clng(instrb(formdata,bncrlf))-1)

datastart=instrb(formdata,bncrlf & bncrlf)+4

dataend=instrb(datastart+1,formdata,divider)-datastart

mydata=midb(formdata,datastart,dataend)


set connGraph=server.CreateObject("ADODB.connection")

connGraph.ConnectionString="driver={Microsoft Access Driver (*.mdb)};DBQ=" &

server.MapPath("images.mdb") & ";uid=;PWD=;"

connGraph.Open


set rec=server.createobject("ADODB.recordset")

rec.Open "SELECT * FROM [images] where id is null",connGraph,1,3

rec.addnew

rec("img").appendchunk mydata

rec.update

rec.close

set rec=nothing

set connGraph=nothing

%>

好了,这下我们就把上传来的图片保存到了名为images.mdb的数据库中

了,剩下的工作就是要将数据库中的图片数据显示到网页上面了。一般在HT

ML中,显示图片都是使用<IMG>标签,也就是<IMG SRC="图片路径">,但

是我们的图片是保存到了数据库中,“图片路径”是什么呢?呵呵,其实这个

SRC属性除了指定路径外,也可以这样使用哦:

<IMG SRC="showimg.asp?id=xxx">

所以,我们所要做的就是在showimg.asp中从数据库中读出来符合条件的

数据,并返回到SRC属性中就可以了,具体代码如下(showimg.asp):

<%

set connGraph=server.CreateObject("ADODB.connection")

connGraph.ConnectionString="driver={Microsoft Access Driver (*.mdb)};DBQ=" &

server.MapPath("images.mdb") & ";uid=;PWD=;"

connGraph.Open

set rec=server.createobject("ADODB.recordset")

strsql="select img from images where id=" & trim(request("id"))

rec.open strsql,connGraph,1,1

Response.ContentType = "image/*"

Response.BinaryWrite rec("img").getChunk(7500000)

rec.close

set rec=nothing

set connGraph=nothing

%>

注意在输出到浏览器之前一定要指定Response.ContentType = "image/*",

以便正常显示图片。

最后要注意的地方是,我的process.asp中作的处理没有考虑到第一页

(upload.htm)中还有其他数据,比如<INPUT type=tesxt name=userid>等等,如果

有这些项目,你的process.asp就要注意处理掉不必要的数据。

怎么样,其实上传图片并保存到数据库很简单吧,这样再也不用为自己的

空间无法使用各类的上传组件发愁了吧。
ChinaOk 2002-05-09
  • 打赏
  • 举报
回复
楼上的说的mdac到这里下
data access 2.6 sp1
http://www.microsoft.com/data/download_26sp1.htm
julyclyde 2002-05-09
  • 打赏
  • 举报
回复
98安装MDAC即可支持
艾恩ASP无组件上传类,不敢夸口说多完美,但能实现基本的功能.包括提取表单数据、上传到不同文件夹、保存到数据库(上传和保存表单可同时进行)、限制上传扩展名、限制上传大小、选择文件保存类型(原文件名和时间随机命名)等! 本类可以完整保存用户信息,包括同名称表单(和request.form一样以,为分割符进行保存),以及文件域的客户端路径。 处理完数据后,程序会提供两个方法-----files和forms,通过这两个方法实现文件的保存以及信息的读取,并且可以调用fileaction类的GetBytes方法获取文件的二进制数据,可以把此数据保存到数据库(作者不推荐把二进制保存到数据库,会影响数据库性能)。 此类最大的优点更多表现在多文件上传,即可以使用循环把所有文件保存到同一目录,又可以单独操作保存到不同目录,灵活性相当高,完全脱离其他任何对象的束缚。并且可以自主选择保存方式--以原文件名保存或以程序自动生成的文件名(时间+随机数字)保存 本类特点: ?尽量追求简洁,减少赘余代码 ?全面保存客户提交的信息(普通表单,文件域值,相同表单值) ?准确获取上传中的错误信息 ?可选择文件保存方式(以原文件名保存和以新文件名保存,新文件名为时间+随机数字组 ?文件保存函数简洁,调用方便,并且比较灵活(保存路径和保存方式可随时改变) ?同时可以获取文件的二进制形式,从而可以实现将二进制数据保存到数据库 ?灵活运用本类,可以实现表单数据和文件同时编辑(这是一般类无法达到的) ?更多的用途靠大家来发现了..... ?Demo里面有几个个很简单的例子,能掌握这几个个例子一定可以灵活使用本类

28,404

社区成员

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

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