真正无组件图文混合上传，功能强大，无须数据库，支持中文！-数据库其他-idc中文资讯站-客观公证的IDC产业权威媒体,关注域名、虚拟主机、服务器、网络、开源技术资讯，整合运营商资源，客观评价各地机房带宽线路质量、IDC企业名录等信息

真正无组件图文混合上传，功能强大，无须数据库，支持中文！

来源：作者：发布时间:2007-12-26 02:16:24

    受本论坛某些帖子启发，于是动手编写了这个程式。该程式支持任何文本和二进制格式文档的上传；支持文档表单域和普通表单域混合上传；支持中文文档名；支持覆盖上传和文档同名时自动修改文档名；支持同时上传多个文档，而且多个文档表单域名能够相同；支持上传文档大小的控制…… 我自己感觉很不错哟：)
    本程式无须任何数据库支持，直接将上传的文档保存到服务器指定的路径下。
    测试环境：windows2000 + iis 5.0(对ado版本有需要)
    已知bug：利用相同文档表单名以唯一文档名方式同时上传多个文档，且服务器上存在多个相同文档名时，只有第一个文档会自动改名上传成功，然后程式报错。
源代码如下，欢迎大家参考指正：

文档名：uploadx.asp
<%
dim formdata, formsize, divider, bcrlf
formsize = request.totalbytes
formdata = request.binaryread(formsize)
bcrlf = chrb(13) & chrb(10)
divider = leftb(formdata, instrb(formdata, bcrlf) - 1)

将上传的文档保存到path所指定的目录下面。
formfield  上传表单的"file"域名
path       要保存文档的服务器绝对路径，形式为："d:＼path＼subpath"或"d:＼path＼subpath＼"
maxsize    限制上传文档的最大长度，以kbyte为单位
savtype    服务器保存文档的方式：
           0   唯一文档名方式，假如有同名则自动改名；
           1   报错方式，假如有同名则出错；
           2   覆盖方式，假如有同名则覆盖原来的文档
function savefile(formfilefield, path, maxsize, savtype)
    dim streamobj,streamobj1
    set streamobj = server.createobject("adodb.stream")
    set streamobj1 = server.createobject("adodb.stream")
    streamobj.mode = 3
    streamobj1.mode = 3
    streamobj.type = 1
    streamobj1.type = 1
    savefile = ""
    startpos = lenb(divider) + 2
    formfilefield = chr(34) & formfilefield & chr(34)
    if right(path,1) <> "＼" then
        path = path & "＼"
    end if
    do while startpos > 0
        strlen = instrb(startpos, formdata, bcrlf) - startpos
        searchstr = midb(formdata, startpos, strlen)
        if instr(bin2str(searchstr), formfilefield) > 0 then
            filename = bin2str(getfilename(searchstr,path,savtype))
            if filename <> "" then
                filestart = instrb(startpos, formdata, bcrlf & bcrlf) + 4
                filelen = instrb(startpos, formdata, divider) - 2 - filestart
                if filelen <= maxsize*1024 then
                       filecontent = midb(formdata, filestart, filelen)
                    streamobj.open
                    streamobj1.open
                    streamobj.write formdata
                    streamobj.position=filestart-1
                    streamobj.copyto streamobj1,filelen
                    if savtype =0 then
                        savtype = 1
                    end if
                    streamobj1.savetofile path & filename, savtype
                    streamobj.close
                    streamobj1.close
                    if savefile <> "" then
                        savefile = savefile & ","  & filename
                    else
                        savefile = filename
                    end if
                else
                    if savefile <> "" then
                        savefile = savefile & ",*toobig*"
                    else
                        savefile = "*toobig*"
                    end if
                end if
            end if
        end if
        if instrb(startpos, formdata, divider) < 1 then
            exit do
        end if
        startpos = instrb(startpos, formdata, divider) + lenb(divider) + 2
    loop
end function

function getformval(formname)
    getformval = ""
    startpos = lenb(divider) + 2
    formname = chr(34) & formname & chr(34)
    do while startpos > 0
        strlen = instrb(startpos, formdata, bcrlf) - startpos
        searchstr = midb(formdata, startpos, strlen)
        if instr(bin2str(searchstr), formname) > 0 then
               valstart = instrb(startpos, formdata, bcrlf & bcrlf) + 4
               vallen = instrb(startpos, formdata, divider) - 2 - valstart
                  valcontent = midb(formdata, valstart, vallen)
               if getformval <> "" then
                getformval = getformval & "," & bin2str(valcontent)
            else
                getformval = bin2str(valcontent)
            end if
        end if
        if instrb(startpos, formdata, divider) < 1 then
            exit do
        end if
        startpos = instrb(startpos, formdata, divider) + lenb(divider) + 2
    loop
end function

function bin2str(binstr)
   dim varlen, clow, ccc, skipflag
   skipflag = 0
   ccc = ""
   varlen = lenb(binstr)
   for i = 1 to varlen
       if skipflag = 0 then
          clow = midb(binstr, i, 1)
          if ascb(clow) > 127 then
             ccc = ccc & chr(ascw(midb(binstr, i + 1, 1) & clow))
             skipflag = 1
          else
             ccc = ccc & chr(ascb(clow))
          end if
       else
          skipflag = 0
       end if
   next
   bin2str = ccc
end function

function str2bin(str)
    for i = 1 to len(str)
        str2bin = str2bin & chrb(asc(mid(str, i, 1)))
    next
end function

function getfilename(str,path,savtype)
    set fs = server.createobject("scripting.filesystemobject")
    str = rightb(str,lenb(str)-instrb(str,str2bin("filename="))-9)
    getfilename = ""
    filename = ""
    for i = lenb(str) to 1 step -1
        if midb(str, i, 1) = chrb(asc("＼")) then
            filename = midb(str, i + 1, lenb(str) - i - 1)
            exit for
        end if
    next
    if savtype = 0 and fs.fileexists(path & bin2str(filename)) = true then
        hfilename = filename
        rfilename = ""
        for i = lenb(filename) to 1 step -1
            if midb(filename, i, 1) = chrb(asc(".")) then
                hfilename = leftb(filename, i-1)
                rfilename = rightb(filename, lenb(filename)-i+1)
                exit for
            end if
        next
           for i = 0 to 9999
               hfilename = hfilename & str2bin(i)
               if fs.fileexists(path & bin2str(hfilename) & i & bin2str(rfilename)) = false then
                   filename = hfilename & str2bin(i) & rfilename
                   exit for
              end if
           next
       end if
       set fs = nothing
       getfilename = filename
end function
%>

应用举例：

upload.htm

new page 1

upload.asp

<%@ language = vbscript %>

<%
response.write "
name=""" & getformval("name") & """"
response.write "
sex=""" & getformval("sex") & """"
response.write "
province=""" & getformval("province") & """"
response.write "
city=""" & getformval("city") & """"
response.write "
lover=""" & getformval("lover") & """"
dim filename
path = server.mappath("./")
filename = savefile("fruit",path,1024,0)
if filename <> "*toobig*" then
    response.write "

""" & filename & """已上传"
else
    response.write "

文档超出限制太大"
end if

filename = savefile("fruit2",path,1024,0)
if filename <> "*toobig*" then
    response.write "

""" & filename & """已上传"
else
    response.write "

文档超出限制太大"
end if
%>

喜欢本文，那就收藏到：