无组件上传图片到数据库中,asp解决方案(2)
作者:扬子 来源:动网 发布时间:2007-08-03 13:22:00
标签:上传,无组件
fupload.inc
<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
’限制上传图片大小
Dim UploadSizeLimit
’********************************** 得到上传数据 **********************************
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
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
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
’********************************** 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
’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>
0
投稿
猜你喜欢
- 其实这个东西没什么技术含量,就是给大家提供一个给表格加滚动条的思路。运行代码框<html><head><tit
- javascript中要判断一个变量是否为array通常是比较困难的,因为var a = [];alert(t
- 在一次ASP程序中不能正常连接MSSQL出现出错信息如下:以下为引用的内容:HTTP/1.1 200 OK S
- 1.获取所有数据库名: SELECT Name FROM Master..SysDatabases ORDER BY Name2.获取所有表
- 6、遮罩滤镜作用:该滤镜可以为对象建立一个覆盖于表面的膜,其效果就象戴着有色眼镜看物体一样。语法: {filter:mask(color=c
- 因为工作的原因,开发过一个拆分字符串的SQL函数,现在把它贴出来,与大家共勉学习。该函数如下: &
- CSS Type set是一款在线字体调整工具。你可以使用它来对字型进行排版调整并实时的看到CSS代码。在下图中,其中,你可以设置文本的字体
- '************************************* 'asp计算随机数&nb
- 来自某个nb招聘的题目:请给Array本地对象增加一个原型方法,它的用途是删除数组条目中重复的条目(可能有多个),返回值是一个包含被删除的重
- 这段时间常给来面试的同学用《 你是一个职业的页面重构工作者吗? 》中三个部分的不同阶段去做自测,发现很多人都自我感觉良好,给我的回答基本都是
- function f(x){ alert(x); return
- cmake-2.8.3.tar.gzmysql-5.5.8.tar.gz一,cmake-2.8.3的安装:tar -zxf cmake-2.
- 如何显示一个等待或欢迎信息? <% Response.Buffer = True %
- 问题一个已经有内容的 textarea 元素,在执行该元素的 .focus() 方法后,不同的浏览器有不同表现。我们的预期是能够出现在内容后
- 如何显示SQL数据库所有表的名称?<%strSQLDSN = "xxxx"strSQLUser
- 相对于Firefox2来说,Firefox3除了采用全新的Gecko 1.9引擎外,在性能、稳定性和安全性方面进行许多改进,在我们最关心的对
- 自己从工艺品设计到平面设计到网络设计,虽然设计原则不离其宗,但经验下来的心得告诉自己,设计媒介的变化带来很多媒介自身的特殊性,下面总结下网站
- 代码如下: EXEC sp_rename '表名.[原列名]', '新列名', 'column
- 网站开发时经常需要在某个页面需要实现对大量图片的浏览,如果考虑流量的话,大可以像pconline一样每个页面只显示一张图片,让用户每看一张图
- 静态页面是蜘蛛喜欢的,会得到蜘蛛经常光顾的,以至于网站上的内容会得到搜索引擎更多的收录。这里介绍一个asp伪静态的程序实现方法数据库是acc