上传处理程序,在 SWFUpload上增加 ASP版本

发布时间：2023-06-19 14:26:53 所属栏目：Asp教程来源：

导读：SWFUpload上传组件，最初由Vinterwebb.se开发，组件主体由Flash与JavaScript整合而成，主要致力解决多文件、大文件等的上传问题，组件提供了丰富的事件与接口方便web开发者调用，开发者可以通过js与css等很方便的控制

SWFUpload上传组件，最初由Vinterwebb.se开发，组件主体由Flash与JavaScript整合而成，主要致力解决多文件、大文件等的上传问题，组件提供了丰富的事件与接口方便web开发者调用，开发者可以通过js与css等很方便的控制样式和实现想要的上传效果。

但也许是随着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

%>

（编辑：聊城站长网）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!