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

    受本论坛某些帖子启发，于是动手编写了这个程序。该程序支持任何文本和二进制格式文件的上传；支持文件表单域和普通表单域混合上传；支持中文文件名；支持覆盖上传和文件同名时自动修改文件名；支持同时上传多个文件，而且多个文件表单域名可以相同；支持上传文件大小的控制…… 我自己感觉很不错哟：)
    本程序无须任何数据库支持，直接将上传的文件保存到服务器指定的路径下。
    测试环境：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

<html>

<head>
<meta http-equiv="Content-Language" content="zh-cn">
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<meta name="GENERATOR" content="Microsoft FrontPage 4.0">
<meta name="ProgId" content="FrontPage.Editor.Document">
<title>New Page 1</title>
</head>

<body>

<form method="POST" action="upload.asp" enctype="multipart/form-data">
  <p>姓名：<input type="text" name="name" size="20"></p>
  <p>城市：<input type="text" name="city" size="20"></p>
  <p>爱好：1、<input type="text" name="lover" size="10">  2、<input type="text" name="lover" size="10"></p>
  <p>性别：<input type="radio" value="男" checked name="sex">男    
  <input type="radio" name="sex" value="女">女</p>  
  <p>省份：<select size="1" name="province">
  <option selected value="江苏">江苏</option>
  <option value="山西">山西</option>
   
  </select></p>
  爱好(补充)：3、<input type="text" name="lover" size="10">  4、<input type="text" name="lover" size="10">
  <p>作品1：<input type="file" name="fruit" size="20"></p>
  <p>作品1：<input type="file" name="fruit" size="20"></p>
  <p>作品2：<input type="file" name="fruit2" size="20"></p>
  <p><input type="submit" value="提交" name="subbutt"><input type="reset" value="全部重写" name="rebutt"></p>
</form>

</body>

</html>


upload.asp

<%@ LANGUAGE = VBScript %>
<!-- #include file="uploadx.asp" -->
<%
Response.Write "<br>Name=""" & GetFormVal("name") & """"
Response.Write "<br>Sex=""" & GetFormVal("sex") & """"
Response.Write "<br>province=""" & GetFormVal("province") & """"
Response.Write "<br>city=""" & GetFormVal("city") & """"
Response.Write "<br>lover=""" & GetFormVal("lover") & """"
dim filename
path = Server.MapPath("./")
filename = SaveFile("fruit",path,1024,0)
If filename <> "*TooBig*" Then
    Response.Write "<br><br>""" & filename & """已经上传"
Else
    Response.Write "<br><br>文件超出限制太大"
End IF

filename = SaveFile("fruit2",path,1024,0)
If filename <> "*TooBig*" Then
    Response.Write "<br><br>""" & filename & """已经上传"
Else
    Response.Write "<br><br>文件超出限制太大"
End IF
%>

原文转自：http://www.ltesting.net