为SWFUpload增加ASP版本的上传处理程序

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