為SWFUpload增加ASP版本的上傳處理程序

但也許是隨著(zhù)asp的逐漸淡出web開(kāi)發(fā)，官方僅提供了.net、php等版本的上傳處理程序，對于asp開(kāi)發(fā)者來(lái)說(shuō)則需要自行處理服務(wù)器端的數據接收。

剛接觸此組件時(shí)就被它功能強大與靈活方便吸引，由于當時(shí)項目采用asp開(kāi)發(fā)，百度一番后發(fā)現并無(wú)好用的asp上傳處理程序（現在有很多啦^^），看來(lái)只能自己研究開(kāi)發(fā)啦，最初采用處理普通上傳的方法來(lái)截取文件的數據，幾經(jīng)測試發(fā)現并不能有效接收組件傳遞過(guò)來(lái)的文件數據，無(wú)奈只能著(zhù)手分析下它發(fā)送的數據形式，通過(guò)分析發(fā)現它發(fā)送的數據格式還是和普通上傳存在一些區別的，無(wú)論是圖片還是文件都是以octet-stream形式發(fā)送到服務(wù)器的，了解了數據格式，剩下的就是截取啦，下面把我的處理方法分享給需要的朋友，處理速度還算理想。
代碼如下:
<%
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
%>