但也许是随着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
- %>
复制代码 |
上一篇: ASP页面静态化批量生成代码分享(多种方法)下一篇: SmartHTTP 简易HttpRequest类(ASP)
|