为SWFUpload增加ASP版本的上传处理程序
xt
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
%>
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
%>