隋国明-手机版个人主页

网页编程－无组件图文混合上传

该程序支持任何文本和二进制格式文件的上传；支持文件表单域和普通表单域混合上传；支持中文文件名；支持覆盖上传和文件同名时自动修改文件名；支持同时上传多个文件，而且多个文件表单域名可以相同；支持上传文件大小的控制…… 我自己感觉很不错哟：)

　　本程序无须任何数据库支持，直接将上传的文件保存到服务器指定的路径下。

　　测试环境：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

　　 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

　　 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

　　 bin2str = ccc

　　End Function

Function str2bin(str)

　　 For i = 1 To Len(str)

　　 str2bin = str2bin & ChrB(Asc(Mid(str, i, 1)))

　　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

　　 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

　　 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

　　 Set fs = Nothing

　　 GetFileName = FileName

　　End Function

应用举例：

upload.htm

<html>

<head>

　　</head>

<body>

　　 <p>性别：<input type="radio" value="男" checked name="sex">男

　　 </select></p>

　　爱好(补充)：3、<input type="text" name="lover" size="10"> 4、<input type="text" name="lover" size="10">

　　</form>

</body>

</html>

　　upload.asp

<%@ LANGUAGE = VBScript %>

　　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