主题：赢动asp简易上传组件(含例子)

使用很简单的，支持任何结构表单（多文件，文件与文本框）。一看就明了。记得就是在读 GET 的数据要放到执行 getFormData 前就行了。

示例下载 http://www.gzyd.net/lael/asp_upload.rar

更多示例往下看

'author : lael 2006-2-20
'Set dataList = CreateObject("Scripting.Dictionary")
'Set fileList = CreateObject("Scripting.Dictionary")
'dim dividerRe(1)//用来分割多文件及数组的的。
'////// sqlPlus = join(split(trim(formDataList("id")), dividerRe(1)), ", ") //普通表单数组
'/////   分割文件内容是用 dividerRe(0) 分割文件名是用dividerRe(1) //如果文件表单名相同

function getFormData(dataList,fileList, dividerRe)
on error resume next

if request.TotalBytes < 1 then '表示不是上传表单
   getFormData = "error:0"
   exit function
end if

dim crlf, divider, divider2, dstart, dend, dchange, dtmp
dim regxFile, regxElse
dim objStream, oStream, formData

set objStream = Server.CreateObject("adodb.stream")
set oStream = Server.CreateObject("adodb.stream")

objStream.Type = 1
objStream.Mode = 3
objStream.Open
objStream.Write request.BinaryRead(request.TotalBytes)
objStream.Position = 0
formData = objStream.Read

oStream.Type = 1
oStream.Mode = 3
oStream.Open

objStream.Position = 0
objStream.CopyTo oStream

oStream.Position = 0
oStream.Type = 2
oStream.Charset = "gb2312"

divider2 =   oStream.ReadText
divider2 = left(divider2, cdbl(instr(divider2, chr(13) & chr(10)))-1)

oStream.Close

if err then '出错表示不是上传表单
   getFormData = "error:1"

   err.clear

   objStream.Close
   set objStream = nothing
   set oStream = nothing
   exit function
else
   getFormData = "" '是   enctype="multipart/form-data"
end if

if nullempty(divider2) then '没有发现表单数据
   err.clear

   objStream.Close
   set objStream = nothing
   set oStream = nothing
   exit function
end if

crlf = chrB(13) & chrB(10)
regxFile = "Content-Disposition: form-data; name=""([^""]*)""; filename=""([^""]*)"""
regxElse = "Content-Disposition: form-data; name=""([^""]*)"""

divider = leftB(formData, cdbl(instrB(formData, crlf))-1)
dstart = 0 : dend = 0 : dchange = 0 : dtmp = ""

dividerRe(0) = divider
dividerRe(1) = divider2

while true

   dtmp = ""

   dstart = cdbl(dend + dchange + lenB(divider) + 2)
   dend = cdbl(instrB(dstart, formData, crlf))

   oStream.Type = 1
   oStream.Mode = 3
   oStream.Open

   objStream.Position = dstart
   objStream.CopyTo oStream, dend - dstart

   oStream.Position = 0
   oStream.Type = 2
   oStream.Charset = "gb2312"

   dtmp = trim(oStream.ReadText)

   oStream.Close

   if len(dtmp) <= 32 then 'len("Content-Disposition: form-data; ")
    getFormData = ""

    objStream.Close
    set objStream = nothing
    set oStream = nothing
    exit function
   end if

   dstart = instrB(dend, formData, crlf & crlf) + 3
   dend = instrB(dstart, formData, divider) - 3
   dchange = 2
  
   if len(trim(getMatche(regxFile, dtmp, 0))) <> 0 then 'getMatche function in function.inc
    oStream.Type = 1
    oStream.Mode = 3
    oStream.Open

    objStream.Position = dstart
    objStream.CopyTo oStream, dend - dstart

    oStream.Position = 0
    if fileList.Exists(trim(getMatche(regxFile, dtmp, 0))) then
     fileList.Item(trim(getMatche(regxFile, dtmp, 0))) = fileList.Item(trim(getMatche(regxFile, dtmp, 0))) & divider2 & trim(getMatche(regxFile, dtmp, 1))
     dataList.Item(trim(getMatche(regxFile, dtmp, 0))) = dataList.Item(trim(getMatche(regxFile, dtmp, 0))) & divider & oStream.Read 'getMatche function in function.inc
    else
     fileList.Add trim(getMatche(regxFile, dtmp, 0)), trim(getMatche(regxFile, dtmp, 1))
     dataList.Add trim(getMatche(regxFile, dtmp, 0)), oStream.Read 'getMatche function in function.inc
    end if
    oStream.Close
   elseif len(trim(getMatche(regxElse, dtmp, 0))) <> 0 then 'getMatche function in function.inc
    oStream.Type = 1
    oStream.Mode = 3
    oStream.Open

    objStream.Position = dstart
    objStream.CopyTo oStream, dend - dstart

    oStream.Position = 0
    oStream.Type = 2
    oStream.Charset = "gb2312"
    if dataList.Exists(trim(getMatche(regxElse, dtmp, 0))) then
     dataList.Item(trim(getMatche(regxElse, dtmp, 0))) = dataList.Item(trim(getMatche(regxElse, dtmp, 0))) & divider2 & oStream.ReadText 'getMatche function in function.inc
    else
     dataList.Add trim(getMatche(regxElse, dtmp, 0)), oStream.ReadText 'getMatche function in function.inc
    end if
    oStream.Close
   'else
   ' getFormData = ""
   '
   ' objStream.Close
   ' set objStream = nothing
   ' set oStream = nothing
   ' exit function
   end if
wend

end function

rem =========== 正则查找，返回指定组值   ===================
rem author：lael
function getMatche(patrn, str, idx)
   dim regEx, Matches, m
   set regEx = New RegExp
   
   regEx.IgnoreCase = true
   regEx.Global = true
   regEx.Pattern = patrn
   set Matches = regEx.execute(str)
   
   For Each m In Matches
             getMatche = m.SubMatches(idx)
    Exit For
         Next
   
   set Matches = nothing
   set regEx = nothing
end function

function nullempty(byval str)
if isnull(str) then
   nullempty = true
elseif trim(str) = "" then
   nullempty = true
else
   nullempty = false
end if
end function

'保存文件函数

'上传文件名，文件内容
function saveFile(byval filename, byval savepath, byval filedata)
    on error resume next

    dim fext, fname, fpath, oStream

    fname = repByRegx("\s|:|-|\/|\\|\.", cstr(now()) & cstr(timer()), "") & "_" & ranStr(1,9,2)
    fext = trim(Lcase(Mid(filename,InStrRev(filename, ".")+1)))

    if lenb(filedata) / 1024 > 1024 then '1024 KB
        saveFile = "error:3"
        exit function
    end if

    fpath = savepath

    '如果文件夹不存在，创建
    if not file_exists(Server.MapPath(fpath)) then
        createFolder(Server.MapPath(fpath))
    end if

    set oStream = Server.CreateObject("adodb.stream")

    oStream.Type = 1
    oStream.Mode = 3
    oStream.Open
    oStream.Write filedata
    oStream.Position = 0
    oStream.SavetoFile Server.MapPath(fpath & fname & "." & fext), 2
    oStream.Close
    set oStream = nothing

    if err then '保存文件失败
        saveFile = ""
        err.clear
        exit function
    end if

    saveFile = fpath & fname & "." & fext'不要带虚拟目录路径

end function

function createFolder(byval crefolder)
    on error resume next
    Set oFso=Server.CreateObject("Scripting.FileSystemObject")
    oFso.CreateFolder(crefolder)
    Set oFso=nothing
    err.clear
end function

'字符串，正则，替换值
function repByRegx(patrn, str ,repv)
    dim regEx
    set regEx = new RegExp
    regEx.Global = true
    regEx.IgnoreCase = false
   
    regEx.Pattern = patrn
    repByRegx = regEx.replace(str, repv)

    set regEx = nothing
end function

function file_exists(byval filename)
    dim func_fso
    set func_fso = Server.CreateObject("Scripting.FileSystemObject")

    file_exists = func_fso.fileexists(null_val(filename,""))
    if not file_exists then
        file_exists = func_fso.folderexists(null_val(filename,""))
    end if

    set func_fso = nothing
end function

'随机数,开始,结束,长度从1开始计算
function ranStr(byval s,byval e, byval l)
    Dim r
    Randomize '对随机数生成器做初始化的动作。

    for ii = 1 to l
        r = Int((e * Rnd) + s) ' 生成 s 到 e 之间的随机数值
        ranStr = ranStr & r
    next
end function

function null_val(byval str, byval val)
    if isnull(str) then
        null_val = val
        exit function
    elseif trim(cstr(str)) = "" then
        null_val = val
        exit function
    end if
    null_val = cstr(str)
end function






'////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'使用方法一

'html文件
<form method="post" action="upload.asp" enctype="multipart/form-data">
<input name="text1", id="text1" type="text" />
<input name="file1" id="file1" type="file" />
<input name="file2" id="file2" type="file" />
<input type="submit />
</form>


'处理ASP文件

dim text1, upfile1, upfile2
dim formDataList, formFileList
dim formDivider(1)

Set formDataList = CreateObject("Scripting.Dictionary") '数据保存
Set formFileList = CreateObject("Scripting.Dictionary") '数据保存
       
if len(getFormData(formDataList, formFileList, formDivider)) = 0 then

       text1 = formDataList("text1")

       upfile1= saveFile(formFileList("file1"), "upload/", formDataList("file1"))
       upfile2= saveFile(formFileList("file2"), "upload/", formDataList("file2"))

end if


'使用方法二

'html文件
<form method="post" action="upload.asp" enctype="multipart/form-data">
<input name="text1", id="text1" type="text" />
<input name="text1", id="text1" type="text" />
<input name="file1" id="file1" type="file" />
<input name="file1" id="file1" type="file" />
<input type="submit />
</form>


'处理ASP文件

dim text1, text2, upfile1, upfile2
dim formDataList, formFileList
dim formDivider(1)

Set formDataList = CreateObject("Scripting.Dictionary") '数据保存
Set formFileList = CreateObject("Scripting.Dictionary") '数据保存
       
if len(getFormData(formDataList, formFileList, formDivider)) = 0 then
'二进制是用 formDivider(0) 分割,如上传文件内容, 其它用 formDivider(1)分割

       text1 = split(formDataList("text1"), formDivider(1))(0)
        text2 = split(formDataList("text1"), formDivider(1))(1)
      
       upfile1= saveFile(split(formFileList("file1"), formDivider(1))(0), "upload/", split(formDataList("file1"), formDivider(0))(0))
     upfile1= saveFile(split(formFileList("file1"), formDivider(1))(1), "upload/", split(formDataList("file1"), formDivider(0))(1))

end if