发信人: ectide()
整理人: dongbao(2002-04-19 16:37:35), 站内信件
|
去潮流论坛，感受另一个温馨的社区。
太多的网友问过这方面的问题了，这里贴一个完整的实例。该实例通过一个Class，专门处理需要文件上传的表单。你可以不管它是怎么工作，只需要会用它即可。
文件上传类clsUpload.asp
<SCRIPT LANGUAGE=vbscript RUNAT=Server>
Class clsUpload
'========================================================='
' 本模块处理表单提交,并提取表单元素和文件上传信息 '
'========================================================='
Private m_objFiles
Private m_objForm
Public Property Get Form()
Set Form = m_objForm
End Property
Public Property Get Files()
Set Files = m_objFiles
End Property
Private Sub Class_Initialize()
Set m_objFiles = New clsCollection
Set m_objForm = New clsCollection
ParseRequest
End Sub
Private Sub ParseRequest()
Dim lngTotalBytes, lngPosBeg, lngPosEnd, lngPosBoundary, lngPosTmp, lngPosFileName
Dim strBRequest, strBBoundary, strBContent
Dim strName, strFileName, strContentType, strValue, strTemp
Dim objFile
'读取所有的提交数据
lngTotalBytes = Request.TotalBytes
strBRequest = Request.BinaryRead(lngTotalBytes)
'查找第一个边界
lngPosBeg = 1
lngPosEnd = InStrB(lngPosBeg, strBRequest, UStr2Bstr(Chr(13)))
If lngPosEnd > 0 Then
strBBoundary = MidB(strBRequest, lngPosBeg, lngPosEnd - lngPosBeg)
lngPosBoundary = InStrB(1, strBRequest, strBBoundary)
End If
If strBBoundary = "" Then
'表单必须采用 ENCTYPE="multipart/form-data"方式提交
'由于我们已经调用Request.BinaryRead, 所以我们不能再通过
'Request.Form 集合来读取表单元素，我们只好自己处理了
lngPosBeg = 1
lngPosEnd = InStrB(lngPosBeg, strBRequest, UStr2BStr("&"))
Do While lngPosBeg < LenB(strBRequest)
'读取表单元素，生成m_objForm集合
strTemp = BStr2UStr(MidB(strBRequest, lngPosBeg, lngPosEnd - lngPosBeg))
lngPosTmp = InStr(1, strTemp, "=")
strName = URLDecode(Left(strTemp, lngPosTmp - 1))
strValue = URLDecode(Right(strTemp, Len(strTemp) - lngPosTmp))
m_objForm.Add strName, strValue
'查找下一个
lngPosBeg = lngPosEnd + 1
lngPosEnd = InStrB(lngPosBeg, strBRequest, UStr2BStr("&"))
If lngPosEnd = 0 Then lngPosEnd = LenB(strBRequest) + 1
Loop
Else
'查找每一个边界，组装Form和Files集合
Do Until (lngPosBoundary = InStrB(strBRequest, strBBoundary & UStr2Bstr("--")))
'取得元素名称
lngPosTmp = InStrB(lngPosBoundary, strBRequest, UStr2BStr("Content-Disposition"))
lngPosTmp = InStrB(lngPosTmp, strBRequest, UStr2BStr("name="))
lngPosBeg = lngPosTmp + 6
lngPosEnd = InStrB(lngPosBeg, strBRequest, UStr2BStr(Chr(34)))
strName = BStr2UStr(MidB(strBRequest, lngPosBeg, lngPosEnd - lngPosBeg))
'查找名称为 'filename'的元素
lngPosFileName = InStrB(lngPosBoundary, strBRequest, UStr2BStr("filename="))
'如果找到，该元素就是上传文件。否则为一般表单元素
If lngPosFileName <> 0 And lngPosFileName < InStrB(lngPosEnd, strBRequest, strBBoundary) Then 'It is a file
'取得文件名
lngPosBeg = lngPosFileName + 10
lngPosEnd = InStrB(lngPosBeg, strBRequest, UStr2BStr(chr(34)))
strFileName = BStr2UStr(MidB(strBRequest, lngPosBeg, lngPosEnd - lngPosBeg))
'取得ContentType
lngPosTmp = InStrB(lngPosEnd, strBRequest, UStr2BStr("Content-Type:"))
lngPosBeg = lngPosTmp + 14
lngPosEnd = InstrB(lngPosBeg, strBRequest, UStr2BStr(chr(13)))
strContentType = BStr2UStr(MidB(strBRequest, lngPosBeg, lngPosEnd - lngPosBeg))
'得到文件内容
lngPosBeg = lngPosEnd + 4
lngPosEnd = InStrB(lngPosBeg, strBRequest, strBBoundary) - 2
strBContent = MidB(strBRequest, lngPosBeg, lngPosEnd - lngPosBeg)
If strFileName <> "" And strBContent <> "" Then
'创建文件，加入Files集合
Set objFile = New clsFile
objFile.Name = strName
objFile.FileName = Right(strFileName, Len(strFileName) - InStrRev(strFileName, "\"))
objFile.ContentType = strContentType
objFile.Blob = strBContent
m_objFiles.Add strName, objFile
End If
Else '普通表单元素处理
'取得元素的值
lngPosTmp = InStrB(lngPosTmp, strBRequest, UStr2BStr(chr(13)))
lngPosBeg = lngPosTmp + 4
lngPosEnd = InStrB(lngPosBeg, strBRequest, strBBoundary) - 2
strValue = BStr2UStr(MidB(strBRequest, lngPosBeg, lngPosEnd - lngPosBeg))
'加入Form集合
m_objForm.Add strName, strValue
End If
'处理下一个元素
lngPosBoundary = InStrB(lngPosBoundary + LenB(strBBoundary), strBRequest, strBBoundary)
Loop
End If
End Sub
Private Function BStr2UStr(BStr)
'把二进制的串转化为Unicode串
Dim lngLoop
BStr2UStr = ""
For lngLoop = 1 to LenB(BStr)
BStr2UStr = BStr2UStr & Chr(AscB(MidB(BStr,lngLoop,1)))
Next
End Function
Private Function UStr2Bstr(UStr)
'把unicode串转化为二进制的串
Dim lngLoop
Dim strChar
UStr2Bstr = ""
For lngLoop = 1 to Len(UStr)
strChar = Mid(UStr, lngLoop, 1)
UStr2Bstr = UStr2Bstr & ChrB(AscB(strChar))
Next
End Function
Private Function URLDecode(Expression)
'对URL解码?
Dim strSource, strTemp, strResult
Dim lngPos
strSource = Replace(Expression, "+", " ")
For lngPos = 1 To Len(strSource)
strTemp = Mid(strSource, lngPos, 1)
If strTemp = "%" Then
If lngPos + 2 < Len(strSource) Then
strResult = strResult & Chr(CInt("&H" & Mid(strSource, lngPos + 1, 2)))
lngPos = lngPos + 2
End If
Else
strResult = strResult & strTemp
End If
Next
URLDecode = strResult
End Function
End Class
Class clsCollection
Private m_objDicItems
Private Sub Class_Initialize()
Set m_objDicItems = Server.CreateObject("Scripting.Dictionary")
m_objDicItems.CompareMode = vbTextCompare
End Sub
Public Property Get Count()
Count = m_objDicItems.Count
End Property
Public Default Function Item(Index)
Dim arrItems
If IsNumeric(Index) Then
arrItems = m_objDicItems.Items
If IsObject(arrItems(Index)) Then
Set Item = arrItems(Index)
Else
Item = arrItems(Index)
End If
Else
If m_objDicItems.Exists(Index) Then
If IsObject(m_objDicItems.Item(Index)) Then
Set Item = m_objDicItems.Item(Index)
Else
Item = m_objDicItems.Item(Index)
End If
End If
End If
End Function
Public Function Key(Index)
Dim arrKeys
If IsNumeric(Index) Then
arrKeys = m_objDicItems.Keys
Key = arrKeys(Index)
End If
End Function
Public Sub Add(Name, Value)
If m_objDicItems.Exists(Name) Then
m_objDicItems.Item(Name) = Value
Else
m_objDicItems.Add Name, Value
End If
End Sub
End Class
Class clsFile
Private m_strName
Private m_strContentType
Private m_strFileName
Private m_Blob
Public Property Get Name() : Name = m_strName : End Property
Public Property Let Name(vIn) : m_strName = vIn : End Property
Public Property Get ContentType() : ContentType = m_strContentType : End Property
Public Property Let ContentType(vIn) : m_strContentType = vIn : End Property
Public Property Get FileName() : FileName = m_strFileName : End Property
Public Property Let FileName(vIn) : m_strFileName = vIn : End Property
Public Property Get Blob() : Blob = m_Blob : End Property
Public Property Let Blob(vIn) : m_Blob = vIn : End Property
Public Sub Save(Path)
Dim objFSO, objFSOFile
Dim lngLoop
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Set objFSOFile = objFSO.CreateTextFile(objFSO.BuildPath(Path, m_strFileName))
For lngLoop = 1 to LenB(m_Blob)
objFSOFile.Write Chr(AscB(MidB(m_Blob, lngLoop, 1)))
Next
objFSOFile.Close
End Sub
End Class
</SCRIPT>
测试例子test.asp：
<%@ Language=VBScript %>
<!-- #include file="clsUpload.asp" -->
<form method=post enctype="multipart/form-data" action=test.asp>
姓名：
<input type=text name=YourName>
文件名：
<input type=file name=YourFile>
<input type=submit name=submit value="立即上传">
</form>
<HR>
<%
Dim objUpload, lngLoop
'通过Request.TotalBytes可以控制上传文件的大小
If Request.TotalBytes > 0 Then
Set objUpload = New clsUpload%>
上传文件的个数: <%= objUpload.Files.Count %>
<%
For lngLoop = 0 to objUpload.Files.Count - 1
'如果允许用户匿名上传，就要设置c:\upload\为匿名用户可写
objUpload.Files.Item(lngLoop).Save "c:\upload\"
%>
表单元素名称:
<%= objUpload.Files.Key(lngLoop) %>
文件名:
<%= objUpload.Files.Item(lngLoop).FileName %>
<%Next%>
其他表单元素: <%= objUpload.Form.Count %>
<%For lngLoop = 0 to objUpload.Form.Count - 1%>
名称:
<%= objUpload.Form.Key(lngLoop) %>
值:
<%= objUpload.Form.Item(lngLoop) %>
<%Next
End If
%>
|
|