<div style="text-indent: 2em;">
示例网页：无组件上传文件
源代码：点击下载
本文提供了一个无组件上传文件的解决方案。它由5个文件组成。
- UploadFile.asp，上传文件的前台页面，供用户选择要上传的文件。
- UploadFile_Process.asp，后台过渡文件，可以在这里做一些个性化的设置，如上传到哪个文件夹等等。
- CBeanFile.asp，用来做一些验证工作，如果通过验证就上传文件到指定目的地（通过调用下面的两个文件）。
- CFile.asp，文件类，存储上传的文件数据，如文件名等等，它有一个方法用来将文件数据保存到指定的文件夹。
- CFormDataGetter.asp，表单数据获取类，这是上传文件的核心程序，对提交的表单进行分析，并取出文件数据。
下面分别来建立这5个文件，然后访问Upload.asp就可以运行了(假设这5个文件都放在你的本地服务器的Example文件下，那么只需在浏览器地址栏里输入http://localhost/Upload/UploadFile.asp就可以访问)。虽然这个过程需要写比较长的代码，但是好在它们已经写好了，你可以只需要复制粘贴即可，当然，在应用到你自己的网站时，需要进行一些个性化的改造，但这些改造非常简单，因为核心程序可以方便地移植，不用做任何修改。
虽然源代码就在下面，但是你现在可能不想细看，而且还懒得复制粘贴，那么有一个好消息，可以直接下载源代码，部署到自己的网站中就可以正常工作了。嗯，先让它工作起来，再来做个性化的修改，比先看懂代码再粘贴，的确是个更不错的思路。
一、UploadFile.asp，基本就是一个HTML文件
<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<% Option Explicit %>
<%Session.CodePage=65001%>
<%
' 此函数用来显示一些提示信息。
' 当上传之后，你可以将一些反馈信息（如成功还是失败等）
' 放在Session变量里，然后在相应的页面中将信息显示出来。
' 以下两个函数正是用来做这件事
Function ShowInfo()
ShowInfo = ShowInfoFrom("ssnInfo", True)
End Function
Public Function ShowInfoFrom(ByRef sSessionName, ByVal bDelete)
Dim s, i, aInfo, ll, lu, sT
On Error Resume Next
aInfo = Session(sSessionName)
If Err.Number <> 0 Then
ShowInfo = ""
Exit Function
End If
ll = LBound(aInfo)
If Err.Number = 0 Then
lu = UBound(aInfo)
For i = ll to lu
sT = aInfo(i)
If Len(sT) > 0 Then
s = s & "<li>" & sT & "</li>"
End If
Next
If Len(s) > 0 Then
s = "<ul>" & s & "</ul>"
End If
Else
s = aInfo
End If
On Error Goto 0
IF Len(s) > 0 Then
s = "<div class="" info""=""><div class="" arrowbottom""=""></div><div class="" leftupfillet""=""></div><div class="" rightupfillet""=""></div><div class="" leftbottomfillet""=""></div><div class="" rightbottomfillet""=""></div>" & s & "</div>"
End If
ShowInfoFrom = s
If bDelete Then Session(sSessionName) = ""
End Function
%>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
<style type="text/css">
form label
{
width: 3em;
display: inline-block;
}
#idUploadInfo
{
display: none;
}
</style>
<script type="text/javascript">
var oImg = new Image();
oImg.src = "wait.gif";
function upload() {
document.getElementById('idUpload').style.display = 'none';
document.getElementById('idUploadInfo').style.display = 'block';
}
</script>
<title>无组件上传文件示例</title>
</head>
<body>
<div id="idInfo"><%= ShowInfo %></div>
<form name="fmUpload" action="UploadFile_Process.asp" method="post" enctype="multipart/form-data">
<div id="idUpload">
<p><label for="idFile">文件：</label><input type="file" name="File" /></p>
<p><label for="idSubmit"></label><input type="submit" name="submit" onclick="upload();" /></p>
</div>
<div id="idUploadInfo">
<img src="wait.gif" alt="正在上传……" />
<p>正在上传……</p>
</div>
<p>可以上传的文件类型：.jpg, .bmp, .gif</p>
<p>文件大小限制：1.5兆</p>
<p>(以上限制可以在后台修改。)</p>
</form>
</body>
</html>
二、UploadFile_Process.asp
<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<% Option Explicit %>
<%Session.CodePage=65001%>
<html-->
<!--#include file="CBeanFile.asp"-->
<head>
<title>上传文件处理</title>
<style type="text/css">
<!--
-->
</style>
<script type="text/javascript">
<!--
//-->
</script>
</head>
<body>
<div id="divWrapWrap">
<div id="divWrap">
<div id="divWrap_Content">
<div class="doodleBox">
<div class="header"><strong>上传文件处理</strong></div>
<div class="body">
<%
AvoidDuplicateSubmit_Lock ' 防止多次提交
Dim bean
Set bean = New CBeanFileForExample
If bean.validate() Then
' 如果通过验证，bean文件会自己处理上传的过程，这里什么也不用做，当然你可以添加一些
' 自定义消息，如上传成功之类的提示信息在这里。实际上bean连这种提示信息也做好了。
Else
' 如果没有通过验证呢？实际上bean文件也做了相应的处理，你也可以在这里什么都不做
Response.Write("没有选择文件")
End If
Set bean = Nothing
%>
</div>
</div>
</div>
</div>
</div>
</body>
</html>
<%
' 返回到前一页
Response.Redirect Request.ServerVariables("HTTP_REFERER")
'
' 防止多次重复提交相同的数据
'
Function AvoidDuplicateSubmit_Lock()
Session("ssnlPostCount") = Clng(Session("ssnlPostCount")) + 1
If Session("ssnlPostCount") > 1 Then
Session("errors") = "您已经提交过了"
Session("ssnlPostCount") = 0
Response.Write(Session("errors"))
Response.Write("<a href='" & Request.ServerVariables("HTTP_REFERER") & "'>返回</a>")
Response.End
End If
AvoidDuplicateSubmit_Unlock
End Function
'
' 防止多次重复提交相同的数据
'
Function AvoidDuplicateSubmit_Unlock()
Session("ssnlPostCount") = 0
End Function
%>
三、CBeanFile.asp 文件
<!--#include file="CFormDataGetter.asp"-->
<%
Class CBeanFileForExample
Private oForm
Private oFile
' 文件大小限制
Private lSizeLimited
' 文件上传到哪个文件夹下？
Private sPathForUpload
' 文件保存到数据库的哪个表中？
Private sTableRecordsUpload
Private sUserName
' 缩略图的宽度与高度的最大值的限制
Private lThumbnailDimentionSizeLimit
Private Function bValidateExp(ByRef sPattern, ByRef s)
Dim regEx
Set regEx = Server.CreateObject("VBScript.RegExp")
regEx.Global = True
regEx.IgnoreCase = True
regEx.Pattern = sPattern
bValidateExp = regEx.Test(s)
Set regEx = Nothing
End Function
Private Sub Class_Initialize()
Set oForm = New CFormDataGetter
Set oFile = New CFile
' 限定文件大小为1.5兆
Me.SizeLimited = (1024 * 1024) * 1.5
Me.PathForUpload = "Upload"
Me.TableRecordsUpload = "MF_Gallery"
Me.UserName = ""
Me.LogPath = ""
Me.LogFileName = "DataRead.xml"
Me.ThumbnailDimentionSizeLimit = 200
Me.GetRequest
End Sub
Private Sub Class_Terminate()
Set oForm = Nothing
Set oFile = Nothing
End Sub
Public Sub GetRequest()
Set oFile = oForm.GetFile("File")
End Sub
Public Function Validate()
Validate = True
If Me.Form.FormSize <= 0 Then
AddInfo("没有选择文件")
Validate = False
Else
If Me.File Is Nothing Then
AddInfo("上传文件出现未知错误，请确认上传方式是否正确 （请检查<form></form>元素的 enctype 属性设置）")
Validate = False
Else
If Me.File.Size <= 0 Then
AddInfo("没有选择文件或者文件大小为 0 字节")
Validate = False
End If
End If
End If
If Validate Then
' 开始对上传的文件进行分析
Dim bnsFileFlag, sFileType
bnsFileFlag = LeftB(Me.File.BinaryStream, 3)
' 对文件类型进行检测
Select Case Me.Form.ConvertBinaryToString(bnsFileFlag)
Case "GIF"
Case Else
Select Case LeftB(bnsFileFlag, 2)
Case Me.Form.ConvertStringToBinary("BM"), Me.Form.ConvertStringToBinary("BA"), Me.Form.ConvertStringToBinary("CI"), Me.Form.ConvertStringToBinary("CP"), Me.Form.ConvertStringToBinary("IC"), Me.Form.ConvertStringToBinary("PT")
Case ChrB(&HFF) & ChrB(&HD8)
' 有可能是JPEG格式文件
Case Else
AddInfo "目前不支持此文件（ " & Me.File.Name & " ）的类型，不能上传"
Validate = False
End Select
End Select
End If
' 检测文件大小是否超限
If Validate Then
If Me.File.Size > Me.SizeLimited Then
AddInfo "目前最大只能上传大小为 " & Me.SuitableUnit(Me.SizeLimited) & " 的文件，而你选择的文件( " & Me.File.Name & " )的大小为 " & Me.SuitableUnit(Me.File.Size) & "，超出了限制"
Validate = False
End If
End If
If Validate Then
' 通过所有的检测，开始上传
' 检测指定的上传路径是否存在
Dim oFSTest
Set oFSTest = Server.CreateObject("Scripting.FileSystemObject")
If Not oFSTest.FolderExists(Server.MapPath(Me.PathForUpload)) Then
' 如果不存在则创建一个
oFSTest.CreateFolder(Server.MapPath(Me.PathForUpload))
End if
Set oFSTest = Nothing
' 上传目的地路径
Dim sPermanentLink, oMF, sSQL, sState, oDB
sState = Me.File.Save(Server.MapPath(Me.PathForUpload) & "\" & Me.File.Name, 2)
If sState = "OK" Then
AddInfo("上传文件成功，文件链接地址为：<a href=""" & Me.PathForUpload & "/" & Me.File.Name & """ target=""_blank"" title=""点击查看"">" & Me.PathForUpload & "/" & Me.File.Name & "</a>")
Else
AddInfo sState
Validate = False
End If
End IF
End Function
Public Property Get Form()
Set Form = oForm
End Property
Public Property Let Form(ByRef o)
Set oForm = o
End Property
Public Property Get File()
Set File = oFile
End Property
Public Property Let File(ByRef o)
Set oFile = o
End Property
Public Property Get SizeLimited()
SizeLimited = lSizeLimited
End Property
Public Property Let SizeLimited(ByVal l)
lSizeLimited = l
End Property
Public Property Get PathForUpload()
PathForUpload = sPathForUpload
End Property
Public Property Let PathForUpload(ByRef s)
sPathForUpload = s
End Property
Public Property Get TableRecordsUpload()
TableRecordsUpload = sTableRecordsUpload
End Property
Public Property Let TableRecordsUpload(ByRef s)
sTableRecordsUpload = s
End Property
Public Property Get UserName()
UserName = sUserName
End Property
Public Property Let UserName(ByRef s)
sUserName = s
End Property
Public Property Get LogPath()
ON Error Resume Next
LogPath = Session("ssnLogPath")
If Err.number <> 0 Then
LogPath = ""
End If
On Error Goto 0
End Property
Public Property Let LogPath(ByRef s)
Session("ssnLogPath") = s
End Property
Public Property Get LogFileName()
On Error Resume Next
LogFileName = Session("ssnLogFileName")
If Err.number <> 0 then
LogFileName = "DataReadLog.xml"
end If
On Error Goto 0
End Property
Public Property Let LogFileName(ByRef s)
Session("ssnLogFileName") = s
End Property
Public Property Get ThumbnailDimentionSizeLimit()
ThumbnailDimentionSizeLimit = lThumbnailDimentionSizeLimit
End Property
Public Property Let ThumbnailDimentionSizeLimit(ByVal l)
lThumbnailDimentionSizeLimit = l
End Property
'
' 将以字节为单位的数字转换成合适单位的值
'
Public Function SuitableUnit(ByVal lB)
Dim i, lVal, aUnit
aUnit = Array("B", "KB", "MB", "GB", "TB")
lVal = Abs(lB)
i = 0
While lVal >= 1024 And i < UBound(aUnit)
i = i + 1
lVal = lVal / 1024
Wend
SuitableUnit = Sgn(lB) * Round(lVal, 2) & " " & aUnit(i)
End Function
' 添加信息
Public Function AddInfo(ByRef s)
AddInfo2 s, "ssnInfo"
End Function
' 添加信息到
Public Function AddInfo2(ByRef s, ByRef sSessionName)
Dim aInfo, ll, lu
If Len(s) <= 0 Then
Exit Function
End If
On Error Resume Next
aInfo = Session(sSessionName)
If Err.Number <> 0 Then
aInfo = ""
End If
Err.Clear
'测试已有信息是否是数组
ll = LBound(aInfo)
If Err.Number <> 0 Then
' 不是数组
If Len(aInfo) > 0 Then
aInfo = Array(aInfo, s)
Else
aInfo = s
End If
Else
' 是数组
lu = UBound(aInfo)
Redim Preserve aInfo(lu + 1)
aInfo(lu+1) = s
End If
On Error Goto 0
Session(sSessionName) = aInfo
End Function
End Class
%>
四、CFile.asp 文件
<% '**************************************************** '文件名: CFile.asp '描 述：文件类 ' ' '****************************************************'# Using CFormDataGetter.asp
Class CFile ' 完整的路径名＋文件名＋后缀名 Private sFullName Private sDescription Private sMIME Private bnsContent Private csClass
Private Sub Class_Initialize() csClass = "CFile" End Sub Public Property Get FullName() FullName = sFullName End Property Public Property Let FullName(ByRef sNewFullName) sFullName = sNewFullName End Property ' 获取文件的路径，不含文件名 Public Property Get Path() Path = Left(sFullName, InStrRev(sFullName, "\")) End Property ' 去掉路径的文件名＋后缀名 Public Property Get Name() Name = Right(sFullName, Len(sFullName) - InStrRev(sFullName, "\")) End Property ' 去掉路径后的文件名 (不要后缀名) Public Property Get ShortName() Dim i i = InStrRev(Me.Name, ".") If i > 0 Then ShortName = Left(Me.Name, InStrRev(Me.Name, ".") - 1) Else ShortName = Me.Name End If End Property Public Property Let Description(ByRef sNewDesc) sDescription = sNewDesc End Property Public Property Get Description() Description = sDescription End Property Public Property Let MIME(ByRef sNewMIME) sMIME = sNewMIME End Property Public Property Get MIME() MIME = sMIME End Property Public Property Get Size() Size = LenB(Me.BinaryStream) End Property ' ' 设置文件的二进制流 ' Public Property Let BinaryStream(ByRef bnsNewBinaryStream) bnsContent = bnsNewBinaryStream End Property ' ' 获取文件的文本 ' Public Property Get TextStream(ByRef sCharset) Dim stm Set stm = Server.CreateObject("ADODB.Stream") stm.Type = 2 stm.Open stm.WriteText bnsContent stm.Position = 0 If Len(sCharset) > 0 Then stm.Charset = sCharset TextStream = stm.ReadText stm.Close Set stm = Nothing End Property ' ' 获取文件的二进制流 ' Public Property Get BinaryStream() BinaryStream = bnsContent End Property ' 后缀名 Public Property Get Ext() Ext = Right(Me.Name, Len(Me.Name) - InStrRev(Me.Name, ".")) End Property Private Sub CFile_Initialize() sFullName = "" sDescription = "" sMIME = "" bnsContent = ChrB(0) End Sub ' ' 打开文件 ' Public Function Open(ByRef sFullName) Dim stm Me.FullName = sFullName Set stm = Server.CreateObject("ADODB.Stream") stm.Type = 2 stm.Mode = 3 stm.Open stm.LoadFromFile sFullName stm.Type = 1 bnsContent = stm.Read stm.Close Set stm = Nothing End Function Public Function Save(ByRef sFullName, ByVal iWriteMode) Dim stm, bns Const sSOURCE = "Save(sFullName, iWriteMode)" 'On Error Resume Next If Trim(sFullName) = "" Or Right(sFullName, 1) = "\" Then Exit Function Set stm = Server.CreateObject("ADODB.Stream") stm.Type = 1 stm.Open stm.Write bnsContent stm.SaveToFile sFullName, iWriteMode stm.Close Set stm = Nothing If err.number <> 0 Then Save = "时间戳：" & Now() & " [" & csClass & "." & sSOURCE & "] 发生错误(sFullName = '" & sFullName & ", iWriteMode = '" & iWriteMode & ")。错误号：" & Err.number & "；错误描述：" & Err.Description & "；错误源：" & Err.Source & "；" Else Save = "OK" End If On Error Goto 0 End FunctionEnd Class %>
五、CFormDataGetter.asp 文件，上传文件最为核心的程序
<!--#include file="CFile.asp"--> <% '**************************************************** '文件名: CFormDataGetter.asp '描 述：这是一个页面表单容器，可以分析每个表单元素的内容，也可用作无组件上传类。 ' ' '**************************************************** '# *Using CFile.asp*Class CFormDataGetter ' 表单字节大小 Private lFormSize ' 表单数据 Private bnsFormData ' 表单数据中字段间的分隔符 private bnsDivider Private bnsVbCrLf Private lChunkBytes Private lReadedBytes
' 字段分隔符 Public Property Get FieldDivider() FieldDivider = bnsDivider End Property Public Property Get FormSize() FormSize = lFormSize End Property Public Property Get FormBinaryData() FormBinaryData = bnsFormData End Property Public Property Get Chunk() Chunk = lChunkBytes End Property Public Property Let Chunk(ByVal l) lChunkBytes = l End Property Public Property Get ReadedBytes() ReadedBytes = lReadedBytes End Property Public Property Let ReadedBytes(ByVal l) lReadedBytes = l End Property Public Property Get LogPath() On Error Resume Next LogPath = Session("ssnLogPath") If Err.number <> 0 Then LogPath = "" End If On Error Goto 0 End Property Public Property Let LogPath(ByVal s) Session("ssnLogPath") = s End Property Public Property Get LogFileName() On Error Resume Next LogFileName = Session("ssnLogFileName") If Err.number <> 0 Then LogFileName = "DataReadLog.xml" End If On Error Goto 0 End Property Public Property Let LogFileName(ByRef s) Session("ssnLogFileName") = s End Property Private Sub Class_Initialize ' 分块数 Dim lChunks, i, lBytesToRead, oStream bnsVbCrLf = ChrB(13) & ChrB(10) ' 获取表单的总字节数 lFormSize = Request.TotalBytes Me.Chunk = 100 * 1024 Me.ReadedBytes = 0 If lFormSize > 0 And Me.Chunk > 0 Then If lFormSize Mod Me.Chunk = 0 Then lChunks = lFormSize \ Me.Chunk Else lChunks = lFormSize \ Me.Chunk + 1 End If Set oStream = Server.CreateObject("ADODB.Stream") oStream.Type = 1 oStream.Mode = 3 oStream.Open ' 分块读取数据 For i = 1 To lChunks ' 如果剩余的数据多于分块，则读进一个分块，否则读进剩余数据 If lFormSize - Me.ReadedBytes > Me.Chunk Then lBytesToRead = Me.Chunk Else lBytesToRead = lFormSize - Me.ReadedBytes End If oStream.Write Request.BinaryRead(lBytesToRead) Me.ReadedBytes = Me.ReadedBytes + lBytesToRead ' 记录读进了多少数据 On Error Resume Next 'LogDataReaded i, Now(), Me.ReadedBytes, lFormSize 'LogDataReadInSession Me.ReadedBytes / lFormSize On Error Goto 0 Next oStream.Position = 0 bnsFormData = oStream.Read Set oStream = Nothing ' 下面开始查找表单数据中字段间的分隔符 Dim lIndex lIndex = CLng(InstrB(bnsFormData,bnsVbCrLf)) If lIndex >= 1 Then ' 成功获取到字段间的分隔符 bnsDivider = LeftB(bnsFormData, lIndex - 1) Else ' bnsDivider = "" End If Else bnsFormData = "" bnsDivider = "" End If End Sub ' ' 记录上传了多少？ ' Public Function LogDataReaded(ByVal lSerialNumber, ByVal sTimeStamp, ByVal lBytesReaded, ByVal lTotalBytes) Dim sFileFullVirtualName, sFileContent, oFS, oFile sFileFullVirtualName = Me.LogPath & Me.LogFileName sFileContent = "<?xml version=""1.0"" encoding=""utf-8""?>" sFileContent = sFileContent & "<datareaded>" sFileContent = sFileContent & "<serialnumber>" & lSerialNumber & "</serialnumber>" sFileContent = sFileContent & "<timestamp>" & sTimeStamp & "</timestamp>" sFileContent = sFileContent & "<bytesreaded>" & lBytesReaded & "</bytesreaded>" sFileContent = sFileContent & "<totalbytes>" & lTotalBytes & "</totalbytes>" sFileContent = sFileContent & "</datareaded>" Set oFS = Server.CreateObject("Scripting.FileSystemObject") Set oFile = oFS.CreateTextFile(Server.MapPath(sFileFullVirtualName), True) oFile.Write sFileContent oFile.Close Set oFile = Nothing Set oFS = Nothing End Function ' ' 获取指字字段名的二进制串 ' Public Function GetFieldBinaryData(ByRef sFieldName) Dim bnsBorder, lIndex, lFieldStart, lFieldEnd, lFieldSize If Me.FormSize <= 0 Then GetFieldBinaryData = "" Exit Function End If ' 字段开始边界 bnsBorder = bnsDivider & bnsVBCrLf & ConvertStringToBinary("Content-Disposition: form-data; name=""" & sFieldName & """") & bnsVbCrLf & bnsVbCrLf lIndex = InStrB(1, Me.FormBinaryData, bnsBorder) If lIndex > 0 Then ' 定位到字段内容的开始位置 lFieldStart = lIndex + LenB(bnsBorder) ' 定位到字段内容的结束位置 lFieldEnd = InStrB(lFieldStart, Me.FormBinaryData, bnsDivider) - 3 ' 计算字段内容的字节长度 lFieldSize = lFieldEnd - lFieldStart + 1 GetFieldBinaryData = MidB(Me.FormBinaryData, lFieldStart, lFieldSize) Else GetFieldBinaryData = bnsBorder End If End Function ' ' 获取指定字段名的文本串 ' Public Function GetFieldTextData(ByRef sFieldName) GetFieldTextData = ConvertBinaryToString(GetFieldBinaryData(sFieldName)) End Function ' ' 将一个文本字符串转换成二进制字符串 ' Public Function ConvertStringToBinary(ByRef s) Dim bns, i For i = Len(s) To 1 Step -1 bns = ChrB(Asc(Mid(s, i, 1))) & bns Next ConvertStringToBinary = bns End Function ' ' 将一个二进制字符串转换成文本字符串 ' ------------------------------------ ' 此方法在localhost上能正确使用，得到理想的效果。但是将网站上传到服务器上时，有时会失灵。 ' 在别的地方看到另一种程序来将二进制字符转换成文本字符串，和我的差不多，但是对于Ascii码大于等于128的，进行跳过，然后使用AscW()对连接两个字符同时进行转换。如下 ' Public Function ConvertBinaryToString(ByVal bns) ' Dim i, s, sClow ' For i = 1 To LenB(bns) ' sClow = MidB(bns, i, 1) ' If AscB(sClow) < 128 Then ' s = s & Chr(AscB(sClow)) ' Else ' i = i + 1 ' If i <= LenB(bns) Then s = s & Chr(AscW(MidB(bns, i, 1) & sClow)) ' End If ' Next ' ConvertBinaryToString = s ' End Function ' Public Function ConvertBinaryToString(ByVal bns) Dim s, i s = "" For i = LenB(bns) To 1 Step -1 s = Chr(AscB(MidB(bns, i, 1))) & s Next ConvertBinaryToString = s End Function ' ' 获取文件 ' Public Function GetFile(ByRef sFieldName) Dim bnsBorder, lIndex, lFieldStart, lFieldEnd, lFieldSize, oFile If Me.FormSize <= 0 Then Set GetFile = Nothing 'AddInfo "表单大小为0字节" Exit Function Else 'AddInfo "表单大小为 " & Me.FormSize & " 字节" End If ' 文件二进制流开始边界 bnsBorder = bnsDivider & bnsVbCrLf & ConvertStringToBinary("Content-Disposition: form-data; name=""" & sFieldName & """; filename=""") lIndex = InStrB(1, Me.FormBinaryData, bnsBorder) If lIndex > 0 Then Set oFile = New CFile ' 以下获取文件完整路径名 ' 定位到第1个字符 lFieldStart = lIndex + LenB(bnsBorder) ' 定位到最后1个字符 lFieldEnd = InStrB(lFieldStart, Me.FormBinaryData, bnsVbCrLf) - 2 ' 计算路径字段内容大小 lFieldSize = lFieldEnd - lFieldStart + 1 If lFieldSize > 0 Then ' 文件名 oFile.FullName = Cbns2TextStream(MidB(Me.FormBinaryData, lFieldStart, lFieldSize), "utf-8") ' 以下获取文件的MIME类型 Dim lPos lPos = InStrB(lFieldEnd, Me.FormBinaryData, ConvertStringToBinary("Content-Type: ")) If lPos > 0 Then lFieldStart = lPos + LenB(ConvertStringToBinary("Content-Type: ")) lFieldEnd = InStrB(lFieldStart, Me.FormBinaryData, bnsVbCrLf & bnsVbCrLf) - 1 lFieldSize = lFieldEnd - lFieldStart + 1 If lFieldSize > 0 Then oFile.MIME = ConvertBinaryToString(MidB(Me.FormBinaryData, lFieldStart, lFieldSize)) Else oFile.MIME = "" End If Else oFile.MIME = "" End If ' 以下获取文件内容 lPos = lFieldEnd lFieldStart = InStrB(lPos, Me.FormBinaryData, bnsVbCrLf & bnsVbCrLf) + 4 lFieldEnd = InStrB(lFieldStart, Me.FormBinaryData, bnsDivider) - 3 lFieldSize = lFieldEnd - lFieldStart + 1 If lFieldSize <= 0 Or lFieldStart <= 0 Then oFile.BinaryStream = "" Else Dim stmFormBinaryData, stmFileBinaryData Set stmFormBinaryData = Server.CreateObject("ADODB.Stream") Set stmFileBinaryData = Server.CreateObject("ADODB.Stream") stmFormBinaryData.Type = 1 stmFormBinaryData.Open stmFormBinaryData.Write Me.FormBinaryData stmFileBinaryData.Type = 1 stmFileBinaryData.Open ' 在ADODB.Stream对象里，索引从0开始，而不是VB的其他地方，索引从1开始 'stmFormBinaryData.Position = lFieldStart - 1 stmFormBinaryData.Position = 0 'stmFormBinaryData.CopyTo stmFileBinaryData, lFieldSize stmFormBinaryData.CopyTo stmFileBinaryData ' 使用MidB()或者LeftB()返回的字符串会自动添加一些别的信息，导致结果二进制串与原来的不太一样 'oFile.BinaryStream = MidB(Me.FormBinaryData, lFieldStart, lFieldSize) stmFileBinaryData.Position = lFieldStart - 1 oFile.BinaryStream = stmFileBinaryData.Read(lFieldSize) stmFormBinaryData.Close stmFileBinaryData.Close Set stmFormBinaryData = Nothing Set stmFileBinaryData = Nothing End If Set GetFile = oFile Else oFile.BinaryStream = "" Set GetFile = oFile End If Else ' 未找到文件二进制流开始边界 'AddInfo "未找到文件二进制流开始边界" 'AddInfo "表单数据：" & Cbns2TextStream(Me.FormBinaryData, "utf-8") Set GetFile = Nothing Exit Function End If End Function ' ' 保存文件 ' Public Function SaveFile(ByRef sFieldName, ByRef sFullName, ByVal iWriteMode) Dim bnsBorder, lIndex, lFieldStart, lFieldEnd, lFieldSize, oFile If Me.FormSize <= 0 Then Set GetFile = Nothing Exit Function End If ' 文件二进制流开始边界 bnsBorder = bnsDivider & bnsVbCrLf & ConvertStringToBinary("Content-Disposition: form-data; name=""" & sFieldName & """; filename=""") lIndex = InStrB(1, Me.FormBinaryData, bnsBorder) If lIndex > 0 Then Set oFile = New CFile ' 以下获取文件完整路径名 ' 定位到第1个字符 lFieldStart = lIndex + LenB(bnsBorder) ' 定位到最后1个字符 lFieldEnd = InStrB(lFieldStart, Me.FormBinaryData, bnsVbCrLf) - 2 ' 计算路径字段内容大小 lFieldSize = lFieldEnd - lFieldStart + 1 ' 文件名 oFile.FullName = ConvertBinaryToString(MidB(Me.FormBinaryData, lFieldStart, lFieldSize)) ' 以下获取文件的MIME类型 Dim lPos lPos = lFieldEnd lFieldStart = lPos + 18 lFieldEnd = InStrB(lFieldStart, Me.FormBinaryData, bnsVbCrLf & bnsVbCrLf) - 1 lFieldSize = lFieldEnd - lFieldStart + 1 oFile.MIME = ConvertBinaryToString(MidB(Me.FormBinaryData, lFieldStart, lFieldSize)) ' 以下获取文件内容 lPos = lFieldEnd lFieldStart = lPos + 5 lFieldEnd = InStrB(lFieldStart, Me.FormBinaryData, bnsDivider) - 3 lFieldSize = lFieldEnd - lFieldStart + 1 oFile.BinaryStream = MidB(Me.FormBinaryData, lFieldStart, lFieldSize) ' 开始保存文件 Dim stm, stmFile If Trim(sFullName) = "" Or Right(sFullName, 1) = "\" Then Exit Function Set stm = Server.CreateObject("ADODB.Stream") Set stmFile = Server.CreateObject("ADODB.Stream") stm.Type = 1 stm.Mode = 3 stm.Open 'stm.Write MidB(Me.FormBinaryData, lFieldStart, lFieldSize) stm.Write Me.FormBinaryData stmFile.Type = 1 stmFile.Open stm.Position = lFieldStart - 1 stm.CopyTo stmFile, lFieldSize stmFile.SaveToFile sFullName, iWriteMode stm.Close stmFile.Close Set stm = Nothing Set stmFile = Nothing Set SaveFile = oFile Else Set SaveFile = Nothing Exit Function End If End Function ' ' 将指定的二进制串转换成特定编码的文本 ' Public Function Cbns2TextStream(ByRef bns, ByRef sCharset) Dim stm Set stm = Server.CreateObject("ADODB.Stream") stm.Type = 2 stm.Open stm.WriteText bns stm.Position = 0 If Len(sCharset) > 0 Then stm.Charset = sCharset Cbns2TextStream = stm.ReadText stm.Close Set stm = Nothing End FunctionEnd Class %>
如果你看到这里，但愿你没有它们吓倒。你可以复制它们，或者直接下载源代码，源代码正是我将以上这些代码拷贝下来保存为文件，将压缩成一个压缩文件的，它们经过了测试，可以正常运行。你下载源代码解压缩后可能会发现其中还包含了一个图片文件，而我在上面却没有提到它，因为它并不是必要的组成部分，只是一个提示上传正在进行的视觉符号而已，你可以替换成其他图片或者文字。