<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 FunctionPublic 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 IfSet 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 lThumbnailDimentionSizeLimitPrivate 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 Function
End 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 Function
End Class %>
如果你看到这里,但愿你没有它们吓倒。你可以复制它们,或者直接下载源代码,源代码正是我将以上这些代码拷贝下来保存为文件,将压缩成一个压缩文件的,它们经过了测试,可以正常运行。你下载源代码解压缩后可能会发现其中还包含了一个图片文件,而我在上面却没有提到它,因为它并不是必要的组成部分,只是一个提示上传正在进行的视觉符号而已,你可以替换成其他图片或者文字。