Add an ASP-based upload handler for SWFUpload.

However, as asp gradually fades out of web development, the official website only provides upload processing programs for. net, php, and other versions. for asp developers, they need to process the server-side data reception on their own.

When I first came into contact with this component, it was attracted by its powerful functionality and flexibility. At that time, the project was developed using asp, baidu once found that there is no easy-to-use asp upload Processing Program (now there are many ^), it seems that you can only research and develop it on your own, initially, the common upload method was used to intercept file data. After several tests, it was found that the file data transmitted by the component could not be effectively received. Instead, the data sent by the component could only be analyzed, the analysis shows that the data format it sends is different from that of normal upload. Both images and files are sent to the server in octet-stream format, and the data format is understood, the rest is interception. I will share my processing method with my friends who need it. The processing speed is still satisfactory.Copy codeThe Code is as follows: <%
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)
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 = partition B (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 limit Rev (sTemp, "|") = 0 Then
SLine = "|"
SPath = sPath & "\" & sTemp
Else
Dim Folder: Folder = Mid (sTemp, limit Rev (sTemp, "|") + 1)
SLine = "|" & Mid (sTemp, 1, Rev (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 call Method
Dim oUpload
Set oUpload = New SWFUpload
OUpload. SaveFolder = "Storage path"
OUpload. GetUploadData
Set oUpload = Nothing
%>