为SWFUpload增加ASP版本的上传处理程序


            但也许是随着asp的逐渐淡出web开发，官方仅提供了.net、php等版本的上传处理程序，对于asp开发者来说则需要自行处理服务器端的数据接收。 刚接触此组件时就被它功能强大与灵活方便吸引，由于当时项目采用asp开发，百度一番后发现并无好用的asp上传处理程序（现在有很多啦^^），看来只能自己研究开发啦，最初采用处理普通上传的方法来截取文件的数据，几经测试发现并不能有效接收组件传递过来的文件数据，无奈只能着手分析下它发送的数据形式，通过分析发现它发送的数据格式还是和普通上传存在一些区别的，无论是图片还是文件都是以octet-stream形式发送到服务器的，了解了数据格式，剩下的就是截取啦，下面把我的处理方法分享给需要的朋友，处理速度还算理想。 复制代码 代码如下: <% Class SWFUpload Private formData, folderPath, streamGet Private fileSize, chunkSize, bofCont, eofCont REM CLASS-INITIALIZE Private Sub Class_Initialize Call InitVariant Server.ScriptTimeOut = 1800 Set streamGet = Server.CreateObject("ADODB.Stream") sAuthor = "51JS.COM-ZMM" sVersion = "Upload Class 1.0" End Sub REM CLASS-INITIALIZE Public Property Let SaveFolder(byVal sFolder) If Right(sFolder, 1) = "/" Then folderPath = sFolder Else folderPath = sFolder & "/" End If End Property Public Property Get SaveFolder SaveFolder = folderPath End Property Private Function InitVariant chunkSize = 1024 * 128 folderPath = "/" : fileSize = 1024 * 10 bofCont = StrToByte("octet-stream" & vbCrlf & vbCrlf) eofCont = StrToByte(vbCrlf & String(12, "-")) End Function Public Function GetUploadData Dim curRead : curRead = 0 Dim dataLen : dataLen = Request.TotalBytes streamGet.Type = 1 : streamGet.Open Do While curRead < dataLen Dim partLen : partLen = chunkSize If partLen + curRead > dataLen Then partLen = dataLen - curRead streamGet.Write Request.BinaryRead(partLen) curRead = curRead + partLen Loop streamGet.Position = 0 formData = streamGet.Read(dataLen) Call GetUploadFile End Function Public Function GetUploadFile Dim begMark : begMark = StrToByte("filename=") Dim begPath : begPath = InStrB(1, formData, begMark & ChrB(34)) + 10 Dim endPath : endPath = InStrB(begPath, formData, ChrB(34)) Dim cntPath : cntPath = MidB(formData, begPath, endPath - begPath) Dim cntName : cntName = folderPath & GetClientName(cntPath) Dim begFile : begFile = InStrB(1, formData, bofCont) + 15 Dim endFile : endFile = InStrB(begFile, formData, eofCont) Call SaveUploadFile(cntName, begFile, endFile - begFile) End Function Public Function SaveUploadFile(byVal fName, byVal bCont, byVal sLen) Dim filePath : filePath = Server.MapPath(fName) If CreateFolder("|", GetParentFolder(filePath)) Then streamGet.Position = bCont Set streamPut = Server.CreateObject("ADODB.Stream") streamPut.Type = 1 : streamPut.Mode = 3 : streamPut.Open streamPut.Write streamGet.Read(sLen) streamPut.SaveToFile filePath, 2 streamPut.Close : Set streamPut = Nothing End If End Function Private Function IsNothing(byVal sVar) IsNothing = IsNull(sVar) Or (sVar = Empty) End Function Private Function StrToByte(byVal sText) For i = 1 To Len(sText) StrToByte = StrToByte & ChrB(Asc(Mid(sText, i, 1))) Next End Function Private Function ByteToStr(byVal sByte) Dim streamTmp Set streamTmp = Server.CreateObject("ADODB.Stream") streamTmp.Type = 2 streamTmp.Mode = 3 streamTmp.Open streamTmp.WriteText sByte streamTmp.Position = 0 streamTmp.CharSet = "utf-8" streamTmp.Position = 2 ByteToStr = streamTmp.ReadText streamTmp.Close Set streamTmp = Nothing End Function Private Function GetClientName(byVal bInfo) Dim sInfo, regEx sInfo = ByteToStr(bInfo) If IsNothing(sInfo) Then GetClientName = "" Else Set regEx = New RegExp regEx.Pattern = "^.*\\([^\\]+)$" regEx.Global = False regEx.IgnoreCase = True GetClientName = regEx.Replace(sInfo, "$1") Set regEx = Nothing End If End Function Private Function GetParentFolder(byVal sPath) Dim regEx Set regEx = New RegExp regEx.Pattern = "^(.*)\\[^\\]*$" regEx.Global = True regEx.IgnoreCase = True GetParentFolder = regEx.Replace(sPath, "$1") Set regEx = Nothing End Function Private Function CreateFolder(byVal sLine, byVal sPath) Dim oFso Set oFso = Server.CreateObject("Scripting.FileSystemObject") If Not oFso.FolderExists(sPath) Then Dim regEx Set regEx = New RegExp regEx.Pattern = "^(.*)\\([^\\]*)$" regEx.Global = False regEx.IgnoreCase = True sLine = sLine & regEx.Replace(sPath, "$2") & "|" sPath = regEx.Replace(sPath, "$1") If CreateFolder(sLine, sPath) Then CreateFolder = True Set regEx = Nothing Else If sLine = "|" Then CreateFolder = True Else Dim sTemp : sTemp = Mid(sLine, 2, Len(sLine) - 2) If InStrRev(sTemp, "|") = 0 Then sLine = "|" sPath = sPath & "\" & sTemp Else Dim Folder : Folder = Mid(sTemp, InStrRev(sTemp, "|") + 1) sLine = "|" & Mid(sTemp, 1, InStrRev(sTemp, "|") - 1) & "|" sPath = sPath & "\" & Folder End If oFso.CreateFolder sPath If CreateFolder(sLine, sPath) Then CreateFolder = True End if End If Set oFso = Nothing End Function REM CLASS-TERMINATE Private Sub Class_Terminate streamGet.Close Set streamGet = Nothing End Sub End Class REM 调用方法 Dim oUpload Set oUpload = New SWFUpload oUpload.SaveFolder = "存放路径" oUpload.GetUploadData Set oUpload = Nothing %>