快捷導(dǎo)航

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

更新時(shí)間：2011年03月25日 15:45:32 作者：

SWFUpload上傳組件，最初由Vinterwebb.se開發(fā)，組件主體由Flash與JavaScript整合而成，主要致力解決多文件、大文件等的上傳問題，組件提供了豐富的事件與接口方便web開發(fā)者調(diào)用，開發(fā)者可以通過js與css等很方便的控制樣式和實(shí)現(xiàn)想要的上傳效果。

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

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

復(fù)制代碼代碼如下:

 
<% 
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 調(diào)用方法 
Dim oUpload 
Set oUpload = New SWFUpload 
oUpload.SaveFolder = "存放路徑" 
oUpload.GetUploadData 
Set oUpload = Nothing 
%> 