ASP无组件文件上传[数据库存储]

ASP无组件文件上传[数据库存储]
可能有不少的朋友介绍了很多无组件文件上传的例子,我也谈谈我的初次的示例，以下为本人初次使用的示例：
第一步： 建立数据库Images
第二步： 建立数据表Image,表结构如下:
     ID         主键，自动列
     ImageName  varchar(50) 文件的名称
     ImageType   varchar(50)  文件的MIME类型
     Image       image      文件字段
     数据库的连接文件保存为：conn.asp（自己修改一下连接)
     <%
 dim conn
 dim connstr
 Set conn = Server.CreateObject("ADODB.Connection")
 connstr="Driver=SQL Server;Server=blankfoxcat;UID=sa;PWD=sa;DataBase=Images"
 conn.Open connstr
     %>

第三步：保存下面的代码为fupload.inc
 
   <SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
'限制上传图片大小
Dim UploadSizeLimit

'********************************** 得到上传数据 **********************************
Function GetUpload()
Dim Result
Set Result = Nothing
set errchk=nothing
If Request.ServerVariables("REQUEST_METHOD") = "POST" Then '检查表单是否以POST形式提交
Dim CT, PosB, Boundary, Length, PosE,errtxt
CT = Request.ServerVariables("HTTP_Content_Type") '读取前页文件头
 If LCase(Left(CT, 19)) = "multipart/form-data" Then '检查表单的Content是以multipart/form-data形式提交
 PosB = InStr(LCase(CT), "boundary=") '找到内容的分界
If PosB > 0 Then Boundary = Mid(CT, PosB + 9) '划出内容部分
Length = CLng(Request.ServerVariables("HTTP_Content_Length")) '给出上传文件的大小
   if "" & UploadSizeLimit<>"" then  '如果有图片上传限制就对比上传文件，否则无限制
   UploadSizeLimit = clng(UploadSizeLimit)
     if Length > UploadSizeLimit then
     Request.BinaryRead(Length)
     exit function
     end if
   end if

     If Length > 0 And Boundary <> "" Then '判断是否有数据提交
     Boundary = "--" & Boundary
     Dim Head, Binary
     Binary = Request.BinaryRead(Length) 'Reads binary data from client

'得到上传文件的解决数据
     Set Result = SeparateFields(Binary, Boundary)
     Binary = Empty 'Clear variables
     End If
  End If
End If

Set GetUpload = Result
End Function

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

'看看是否结束对上传内容的分析？
TwoCharsAfterEndBoundary = BinaryToString(MidB(Binary, PosCloseBoundary + LenB(Boundary), 2))
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

'********************************** Utilities **********************************
Function BinaryToString(str)
strto = ""
for i=1 to lenb(str)
   if AscB(MidB(str, i, 1)) > 127 then
strto = strto & chr(Ascb(MidB(str, i, 1))*256+Ascb(MidB(str, i+1, 1)))
i = i + 1
   else
strto = strto & Chr(AscB(MidB(str, i, 1)))
   end if
next
BinaryToString=strto
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

'找出上传文件的开始和结束的位置
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

'对文件名进行检测并得出结果
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>

第四步：建立文件index.asp 代码如下：提交表单

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<html>
<head>
<title>Untitled Document</title>
<meta http-equiv="Content-Type" content="text/
4000
html; charset=gb2312">
</head>

<body>
<form action="UpFile.asp" method="post" enctype="multipart/form-data" name="form1">
  <p>
    <input type="text" name="ImagesName">
  </p>
  <p>
    <input type="text" name="ImagesContent">
  </p>
  <p>
    <input type="file" name="Images">
  </p>
  <p>
    <input type="submit" name="Submit" value="Submit">
  </p>
</form>
</body>
</html>

第五步：建立文件upfile.asp如下（处理提交的表单）

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<!--#include file="conn.asp"-->
<!--#include file="fupload.inc"-->
<html>
<head>
<title>Untitled Document</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
</head>

<body>
<%
dim ImageName,filevalue,fileContentType
dim Image
if Request.ServerVariables("REQUEST_METHOD") = "POST" Then 
 Set Fields = GetUpload()
 dim Field
 For Each Field In Fields.Items
  select case Field.name
   case "Images"
   filename=field.FileName
   fileContentType=field.ContentType
   filevalue=field.value
   filesize = field.Length
   case "ImagesName"
   imagename=BinaryToString(Field.value)
   case "ImagesContent"
   imageContent=BinaryToString(Field.value)
  end select
 next
 dim rs,sql
 set rs = server.CreateObject("ADODB.RecordSet")
 sql = "select * from Image"
 rs.Open sql,conn,3,3
 rs.addnew
 rs("Imagename")=imagename
 rs("ImageType")=fileContentType
 rs("Image").appendchunk filevalue
 rs.update
 rs.close
 set rs=nothing
 conn.close
 set conn=nothing
end if
%>
</body>
</html>

部分说明：
 rs("Imagename")=imagename
 rs("ImageType")=fileContentType
 rs("Image").appendchunk filevalue
存储了      表单提交的文件名：imagename
上传文件的MIME类型：fileContentType
文件：filevalue

没有存储     表单提交的ImagesContent
上传文件名称：filename
文件大小：filesize
文件的信息主要有如下代码取得:
 select case Field.name
 case "Images"
filename=field.FileName
fileContentType=field.ContentType
filevalue=field.value
filesize = field.Length
case "ImagesName"
建议大家把上传文件的信息在库保存完整,便于读取下载（图片显示),本文没有对文件大小和文件类型的限制，我想已经有文件名，文件MIME类型,文件大小，如何限制就不用多说了吧!