如何在web页面中上载文件

[neverlost]

在web页面中上载文件时使用了enctype="multipart/form-data"，但REQUEST("val")就不能使用了.

[Tedyt]

你可以找一些现成的组件，当然前提是你能控制服务器。
比如说WWW.ACTIVE.COM.CN就有FILEUP组件，用于实现文件的上传。

[voyager]

---- 4． 编写类模块，代码 Zip 2KB

我想要，可以mail给我吗？
[e-mail]

[King]

我也要，我的E-MAIL：[e-mail]

[littletao]

以下是转自computerworld的一篇文章，地址为：
http://www.computerworld.com.cn/99/tips/class.asp?class=6
的第74篇文章。
我试过，完全可以，代码可以从那里dl,或者问我要。

下面，我们以VB6.0中文版环境为例，讲述如何编写上载文件的ASP组件：

---- 1． 进入VB时，选择工程类型为ActiveX DLL。

---- 2． 在工程窗口中选择工程，在属性窗口中给工程重命名，如“Huang”； 在工程窗口中选择类模块“Class1”， 在属性窗口中将其重命名，如“UploadFile”，并且，将Instancing属性设置为“5-MultiUse”。

---- 3． 选择VB菜单“工程—— >引用—— >Microsoft Active Server Pages Object Library”，单击“确定”。

---- 4． 编写类模块，代码 Zip 2KB

---- 对存入文件的目标目录，要有写入的权限。

---- 对OnStartPage过程的说明：当客户请求一个基于ASP的Web文件时，Web 服务器会调用该ASP文件上所有ASP组件的OnStartPage方法。Web开发者可以在OnStartPage过程中访问ASP的内建组件。

---- 5．选择“文件—— >生成Huang.DLL”， 生成Huang.DLL。如果VB就在IIS服务器上，则VB会自动注册该组件；否则，把Huang.DLL拷贝到IIS服务器所在的Windows NT目录下，运行“Regsrv32 Huang.DLL”注册该组件。

---- 至此，文件上载的ASP组件编写并注册完成。

---- 编写upload.asp文件如下：

< %@ Language=VBScript % >
< HTML >
< BODY >
< %
Dim txtValue

Set obj = Server.CreateObject("Huang.UploadFile")
txtValue = obj.GetTheValue("text1")
Response.Write( "text1的输入值是： " & txtValue)
Response.Write "< P > < /p >"
Response.Write "选择的文件已经上载到服务器！"
obj.SaveTheFile "file1", "c:\test"
% >
< /BODY >
< /HTML >
---- 上述例子在VB6.0中文版和IIS4.0中文版下调试通过。

[tsx_tyh]

我发现一个uploadasp.dll.从国外站点找来的，谁要？
[e-mail]

[蝈蝈俊]

我有一篇不用组件上传的文章.可能对你有帮助
全文如下:
下面将介绍一系列可以不用组件，而使用纯粹的ASP代码来上传文件
呵呵，我想这将给很多拥有个人主页的网友带来极大的方便。
这个纯ASP代码由三个包含文件组成，代码中只使用了FileSystemObject
和Direction两个ASP固有对象。而不需要任何附加的组件，注意，为了保证
这段代码的出处，我没有对代码中的任何地方进行过修改。
希望能够对大家有所帮助：
文件fupload.inc
<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
'Sample multiple binary files upload via ASP - upload include
'c1997-1999 Antonin Foller, PSTRUH Software, http://www.pstruh.cz
'The file is part of ScriptUtilities library
'The file enables http upload to ASP without any components.
'But there is a small problem - ASP does not allow save binary data to
the disk.
' So you can use the upload for :
' 1. Upload small text (or HTML) files to server-side disk (Save the d
ata by filesystem object)
' 2. Upload binary/text files of any size to server-side database (RS(
"BinField") = Upload("FormField").Value


'Limit of upload size
Dim UploadSizeLimit

'********************************** GetUpload ************************
**********
'This function reads all form fields from binary input and returns it
as a dictionary object.
'The dictionary object containing form fields. Each form field is repr
esented by six values :
'.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-T
ype header
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 boundar
y
Length = CLng(Request.ServerVariables("HTTP_Content_Length")) 'G
et 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(Leng
th,0) & "B exceeds limit of " & FormatNumber(UploadSizeLimit,0) & "B"

exit function
end if
end if

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

'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, isLastBoundar
y
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 isLas
tBoundary)
'Header and file/source field data
Dim HeaderContent, FieldContent
'Header fields
Dim Content_Disposition, FormFieldName, SourceFileName, Content_Ty
pe
'Helping variables
Dim Field, TwoCharsAfterEndBoundary
'Get end of header
PosEndOfHeader = InstrB(PosOpenBoundary + Len(Boundary), Binar
y, 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), PosCloseBoun
dary - (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, PosCloseBou
ndary + LenB(Boundary), 2))
'Binary.Mid(PosCloseBoundary + Len(Boundary), 2).String
isLastBoundary = TwoCharsAfterEndBoundary = "--"
If Not isLastBoundary Then 'This is not ending boundary - go to ne
xt form field.
PosOpenBoundary = PosCloseBoundary
PosCloseBoundary = InStrB(PosOpenBoundary + LenB(Boundary)
, Binary, Boundary )
End If
Loop
Set SeparateFields = Fields
End Function

'********************************** 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(Fil
eName) - 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>



文件futils.inc
<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
'True PureASP upload - enables save of uploaded text fields to the dis
k.
'c1997-1999 Antonin Foller, PSTRUH Software, http://www.pstruh.cz
'The file is part of ScriptUtilities library
'The file enables http upload to ASP without any components.
'But there is a small problem - ASP does not allow save binary data to
the disk.
' So you can use the upload for :
' 1. Upload small text (or HTML) files to server-side disk (Save the d
ata by filesystem object)
' 2. Upload binary/text files of any size to server-side database (RS(
"BinField") = Upload("FormField").Value

'All uploaded files and log file will be saved to the next folder :
Dim LogFolder
LogFolder = Server.MapPath(".")

'********************************** SaveUpload ***********************
***********
'This function creates folder and saves contents of the source fields
to the disk.
'The fields are saved as files with names of form-field names.
'Also writes one line to the log file with basic informations about up
load.
Function SaveUpload(Fields, DestinationFolder, LogFolder)
if DestinationFolder = "" then DestinationFolder = Server.MapPath(".
")

Dim UploadNumber, OutFileName, FS, OutFolder, TimeName, Field
Dim LogLine, pLogLine, OutLine

'Create unique upload folder
Application.Lock
if Application("UploadNumber") = "" then
Application("UploadNumber") = 1
else
Application("UploadNumber") = Application("UploadNumber") + 1
end if
UploadNumber = Application("UploadNumber")
Application.UnLock

TimeName = Right("0" & Year(Now), 2) & Right("0" & Month(Now), 2) &
Right("0" & Day(Now), 2) & "_" & Right("0" & Hour(Now), 2) & Right("0"
& Minute(Now), 2) & Right("0" & Second(Now), 2) & "-" & UploadNumber

Set FS = CreateObject("Scripting.FileSystemObject")
Set OutFolder = FS.CreateFolder(DestinationFolder + "\" + TimeName)


Dim TextStream
'Save the uploaded fields and create log line
For Each Field In Fields.Items
'Write content of the field to the disk
'!!!! This function uses FileSystemObject to save the file. !!!!!

'So you can only use text files to upload. Save binary files by th
e function takes undefined results.
'To upload binary files see ScriptUtilities, http://www.pstruh.cz


'You can save files with original file names :
'Set TextStream = FS.CreateTextFile(OutFolder & "\" & Field.FileNa
me )

'Or with names of the fields
Set TextStream = FS.CreateTextFile(OutFolder & "\" & Field.Name &
".")

'And this is the problem why only short text files - BinaryToS
tring uses char-to-char conversion. It takes a lot of computer time.
TextStream.Write BinaryToString(Field.Value) ' BinaryToString is i
n upload.inc.
TextStream.Close


'Create log line with info about the field
LogLine = LogLine & """" & LogF(Field.name) & LogSeparator & LogF(
Field.Length) & LogSeparator & LogF(Field.ContentDisposition) & LogSep
arator & LogF(Field.FileName) & LogSeparator & LogF(Field.ContentType)
& """" & LogSeparator
Next

'Creates line with global request info
pLogLine = pLogLine & Request.ServerVariables("REMOTE_ADDR") & LogSe
parator
pLogLine = pLogLine & LogF(Request.ServerVariables("LOGON_USER")) &
LogSeparator
pLogLine = pLogLine & Request.ServerVariables("HTTP_Content_Length")
& LogSeparator
pLogLine = pLogLine & OutFolder & LogSeparator
pLogLine = pLogLine & LogLine
pLogLine = pLogLine & LogF(Request.ServerVariables("HTTP_USER_AGENT"
)) & LogSeparator
pLogLine = pLogLine & LogF(Request.ServerVariables("HTTP_COOKIE"))

'Create output line for the client
OutLine = OutLine & "Fields was saved to the <b>" & OutFolder & "</b
> folder.<br>"

DoLog pLogLine, "UP"

OutFolder = Empty 'Clear variables.
SaveUpload = OutLine
End Function

'Writes one log line to the log file
Function DoLog(LogLine, LogPrefix)
if LogFolder = "" then LogFolder = Server.MapPath(".")
Const LogSeparator = ", "
Dim OutStream, FileName
FileName = LogPrefix & Right("0" & Year(Now), 2) & Right("0" & Month
(Now), 2) & Right("0" & Day(Now), 2) & ".LOG"

Set OutStream = Server.CreateObject("Scripting.FileSystemObject").Op
enTextFile(LogFolder & "\" & FileName, 8, True)
OutStream.WriteLine Now() & LogSeparator & LogLine
OutStream = Empty
End Function

'Returns field or "-" if field is empty
Function LogF(ByVal F)
If "" & F = "" Then LogF = "-" Else LogF = "" & F
End Function

'Returns field or "-" if field is empty
Function LogFn(ByVal F)
If "" & F = "" Then LogFn = "-" Else LogFn = formatnumber(F,0)
End Function

Dim Kernel, TickCount, KernelTime, UserTime
Sub BeginTimer()
on error resume next
Set Kernel = CreateObject("ScriptUtils.Kernel") 'Creates the Kernel
object
'Get start times
TickCount = Kernel.TickCount
KernelTime = Kernel.CurrentThread.KernelTime
UserTime = Kernel.CurrentThread.UserTime
on error goto 0
End Sub

Sub EndTimer()
'Write times
on error resume next
Response.Write "<br>Script time : " & (Kernel.TickCount - TickCount)
& " ms"
Response.Write "<br>Kernel time : " & CLng((Kernel.CurrentThread.Ker
nelTime - KernelTime) * 86400000) & " ms"
Response.Write "<br>User time : " & CLng((Kernel.CurrentThread.UserT
ime - UserTime) * 86400000) & " ms"
on error goto 0
Kernel = Empty
End Sub
</SCRIPT>



文件fformat.inc
<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>

function Foot()
DIM HTML
HTML = "<hr><Table Border=0 Width=100%><TR><TD><font size=1>燬ampl
e upload/download via ASP from <a href=http://www.pstruh.cz>PSTRUH Sof
tware</a>.</font>"
HTML = HTML & "</td><td Align=right><Font Size=1><A HRef=http://ww
w.pstruh.cz/help/ScptUtl/library.htm>Activex Upload</A>?A HRef=http://
www.pstruh.cz/help/usrmgr/library.htm>ActiveX UserManager</A>?A HRef=h
ttp://www.pstruh.cz/help/RSConv/library.htm>DBF on-the-fly</A>?A HRef=
http://www.pstruh.cz/help/tcpip/library.htm>ActiveX DNS+TraceRoute</A>
?A HRef=http://www.pstruh.cz/help/urlrepl/library.htm>URL Replacer</A>
?/Font>"
HTML = HTML & "</td></tr></table></Body></HTML>"
Foot = HTML
end function

function Head(Title, Description)
DIM HTML
HTML = "<HTML><Head>"
HTML = HTML & "<Title>" & Title & "</Title>"
HTML = HTML & "<Meta Content=""" & Description & """ Name=""Descript
ion"">"
HTML = HTML & Style()
HTML = HTML & "</Head>"
HTML = HTML & Body()
Head = HTML
end function

function Body()
DIM HTML
HTML = "<body ALINK=YELLOW bgcolor=White LeftMargin=0 TopMargin=0>"
&vbCrLf
HTML = HTML & ClHead() &vbCrLf
HTML = HTML & Source()
Body = HTML
'<LeftMargin=0 TopMargin=0 Style="margin-right:0pt; margin-top:0pt;
margin-left:0pt;">
end function

function Style()
Style = "<STYLE TYPE=""text/css""><--BODY{font-size:10pt;font-family
: Arial,Arial CE,Helvetica,sans-serif }--></STYLE>"
'<LeftMargin=0 TopMargin=0 Style="margin-right:0pt; margin-top:0pt;
margin-left:0pt;">
end function

function ClHead()
DIM HTML
HTML = HTML & "<TABLE width=100% border=1 cellpadding=1 cellspacing=
0 BORDERCOLOR=WHITE><tr bgcolor=SILVER>"
HTML = HTML & "<th><a href=fupload.asp>Multiple text files upload</a
></th>"
HTML = HTML & "<th><a href=fdbupl.asp>Upload to database</a></th>"
HTML = HTML & "<th><a href=fdbdown.asp>Download from database</a></t
h>"
HTML = HTML & "<th><a href=" & request.servervariables("script_name"
) & "?S=1>View source</a></th>"
HTML = HTML & "</tr></table>"
ClHead = HTML
end function

function Source()
DIM HTML
if request.querystring("S")<>"" then
HTML = HTML & "<pre>" & server.htmlencode(CreateObject("Scripting.
FileSystemObject").OpenTextFile _
(server.mappath(request.servervariables("script_name")), 1, False,
False).readall) & "</pre>"
end if
Source = BasicEncode(HTML)
end function


Function BasicEncode(ByVal VBCode)
' Dim Pom, PosStart, PosEnd
' PosStart = InStr(VBCode, "'")
' Do While PosStart > 0
' PosEnd = InStr(PosStart + 1, VBCode, vbCrLf)
' If PosEnd = 0 Then PosEnd = Len(VBCode)
' Pom = Left(VBCode, PosStart - 1) & "<font color=green>"
' Pom = Pom & Mid(VBCode, PosStart, PosEnd - PosStart - 0) & "</fon
t>"
' Pom = Pom & Mid(VBCode, PosEnd)
' VBCode = Pom
' PosStart = InStr(PosEnd + 1, VBCode, "'")
' Loop
VBCode = FilterBeginEnd(VBCode, "'", vbCrLf, "green")
VBCode = FilterBeginEnd(VBCode, """, """, "brown")
VBCode = FilterWord(VBCode, "Set ", "blue")
VBCode = FilterWord(VBCode, "If ", "blue")
VBCode = FilterWord(VBCode, "For ", "blue")
VBCode = FilterWord(VBCode, " Then", "blue")
VBCode = FilterWord(VBCode, " In ", "blue")
VBCode = FilterWord(VBCode, "Each ", "blue")
VBCode = FilterWord(VBCode, "Function ", "blue")
VBCode = FilterWord(VBCode, "End Function", "blue")
VBCode = FilterWord(VBCode, "MsgBox ", "blue")
VBCode = FilterWord(VBCode, "OutPut ", "blue")
VBCode = FilterWord(VBCode, "Empty", "blue")
VBCode = FilterWord(VBCode, "Debug.Print ", "darkblue")
VBCode = FilterWord(VBCode, "Print ", "blue")
VBCode = FilterWord(VBCode, " And ", "blue")
VBCode = FilterWord(VBCode, " Or ", "blue")
VBCode = FilterWord(VBCode, "Next" & vbcrlf, "blue")
VBCode = FilterWord(VBCode, "Next " , "blue")

VBCode = FilterWord(VBCode, "Response.Write", "darkblue")
VBCode = FilterWord(VBCode, "Response.BinaryWrite" , "darkblue")
VBCode = FilterWord(VBCode, "Response.ContentType" , "darkblue")
VBCode = FilterWord(VBCode, "Response.AddHeader" , "darkblue")

VBCode = FilterWord(VBCode, "Server.CreateObject" , "darkblue")
VBCode = FilterWord(VBCode, "CreateObject" , "darkblue")

' VBCode = FilterWord(VBCode," = ","red")
BasicEncode = VBCode
End Function

Function FilterBeginEnd(ByVal VBCode, ByVal sBegin, ByVal sEnd, ByVal
Color)
Dim Pom, PosStart, PosEnd, FontColor
FontColor = "<font color=" & Color & ">"
PosStart = InStr(ucase(VBCode), ucase(sBegin))
Do While PosStart > 0
PosEnd = InStr(PosStart + Len(sBegin), ucase(VBCode), ucase(sEnd))

If PosEnd = 0 Then PosEnd = Len(VBCode)
Pom = Left(VBCode, PosStart - 1) & FontColor
Pom = Pom & Mid(VBCode, PosStart, PosEnd - PosStart + Len(sEnd)) &
"</font>"
Pom = Pom & Mid(VBCode, PosEnd + Len(sEnd))
VBCode = Pom
PosStart = InStr(PosEnd + Len(FontColor) + Len("</font>") + Len(sE
nd), ucase(VBCode), ucase(sBegin))
Loop
FilterBeginEnd = VBCode
End Function

Function FilterWord(ByVal VBCode, ByVal Word, ByVal Color)
Dim Pom, PosStart, PosEnd, FontWord
FontWord = "<font color=" & Color & ">" & Word & "</font>"
PosStart = InStr(ucase(VBCode), ucase(Word))
Do While PosStart > 0
Pom = Left(VBCode, PosStart - 1) & FontWord
Pom = Pom & Mid(VBCode, PosStart + Len(Word))
VBCode = Pom
PosStart = InStr(PosStart + Len(FontWord), ucase(VBCode), ucase(Wo
rd))
Loop
FilterWord = VBCode
End Function
</SCRIPT>
※ 来源:．网易虚拟社区 http://club.netease.com．[FROM: 202.130.230.7]

[HOMME]

用组件或用CGI，组件可来信问我要

[蝈蝈俊]

用纯ＡＳＰ代码实现图片上传并存入数据库中
（作者：苏红超　2000年04月26日 11:49）


用ＡＳＰ编写网站应用程序时间长了，难免会遇到各式各样的问题，其中

关于如何上传文件到服务器恐怕是遇见最多的问题了，尤其是上传图片，比如

你想要在自己的社区里面实现类似网易虚拟社区提供的“每日一星”的功能，

就要提供给网友上传照片的功能。上传图片文件到服务器可以使用各种免费的

文件上传组件，使用起来功能虽然很强大，但是由于很多情况下，我们只能使

用免费的支持ＡＳＰ的空间或者租用别人的虚拟空间，对于第一种情况，我们

根本就没有可能来使用文件上传组件；至于第二种情况，我们也要付出不少的

“银子”才可以。除非你拥有自己的虚拟主机，你就可以随便的在服务器上面

安装自己所需要的组件，这种情况对于大多数人来说是可望而不可及的。那我

们就没有办法了吗？呵呵，答案是肯定的（当然是肯定的了，要不然我也没法

写出这篇文章啊）。下面就让我们一起来使用纯ＡＳＰ代码来实现图片的上传

以及保存到数据库的功能（顺便也实现显示数据库中的图片到网页上的功

能）。

首先我们先来熟悉一下将要使用的对象方法。我们用来获取上一个页面传

递过来的数据一般是使用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

（无当前记录）。

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

下（Ａｃｃｅｓｓ９７）：

字段名称　　　　类型　　　　描述

　　id 　　　自动编号　　　主键值

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



对于在MS SQL Server7中，对应的结构如下：

字段名称　　　　类型　　　　描述

　　id 　　　　int(Identity)　主键值

img 　　image　　　 　用来保存图片数据　



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

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

（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中获取到的数据不仅仅包含了我们想要的上传上来

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

理过的图片数据保存到数据库中，这里我们以Ａｃｃｅｓｓ９７为例。具体代

码如下（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的数据库中

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

ＭＬ中，显示图片都是使用<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就要注意处理掉不必要的数据。

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

空间无法使用各类的上传组件发愁了吧。还等什么？赶快试一试吧。



（以上所有程序均在WinNT4.0英文版，IIS4，Access97/MS SQL Server7.0中运

行通过）