[CODE]
[CODE]
<%OPTION EXPLICIT%>
<%Server.ScriptTimeOut=5000%>
<!--#include FILE="upload_newlife.inc"-->
<%
dim upload,file,formName,formPath,iCount,fileexeset upload=new upload_newlife ''建立上传对象if upload.form("filepath")="" then ''得到上传目录
HtmEnd "请输入要上传至的目录!"
set upload=nothing
response.end
else
formPath=upload.form("filepath")
''在目录后加(/)
if right(formPath,1)<>"/" then formPath=formPath&"/"
end ifiCount=0for each formName in upload.objForm '列出所有form数据
response.write formName&"="&upload.form(formName)&"<br>"
next
fileexe=mid(formname,instrRev(forname,".")+1)
'fileexe=right(formname,(len(formname)-instrRev(formname,".",-1)))'取得文件后缀名for each formName in upload.objFile ''列出所有上传了的文件 set file=upload.file(formName) ''生成一个文件对象(类对象） if file.FileSize>0 then ''如果 FileSize > 0 说明有文件数据
file.SaveAs Server.mappath(formPath&file.FileName) ''保存文件
file.filename=year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&fileexe
'//'将filepath写入数据库（即记录的地址）//
'response.write file.FilePath&file.FileName&" ("&file.FileSize&") => "&formPath&File.FileName&" 成功!<br>"
iCount=iCount+1
end if
set file=nothing
nextset upload=nothing ''删除此对象
Htmend iCount&" 个文件上传结束! [<a href=''>继续上传</a>"sub HtmEnd(Msg)
response.write "<br>"&Msg&" [<a href=""javascript:history.back();"">返回</a>]</body></html>"
response.end
end sub
%>
[/CODE]
上传函数文件upload_newlife.inc:
[CODE]
<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
'------------------------------------------------------------------------------------
dim Data_newlifeClass upload_newlife
'==========================================
'主函数入口
'==========================================
Private Sub Class_Initialize
dim RequestData,sStart,vbCrlf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,theFile
dim iFileSize,sFilePath,sFileType,sFormValue,sFileName
dim iFindStart,iFindEnd
dim iFormStart,iFormEnd,sFormName
set objForm=Server.CreateObject("Scripting.Dictionary")
set objFile=Server.CreateObject("Scripting.Dictionary") '创建一个容器objForm,objFile
if Request.TotalBytes<1 then Exit Sub
set tStream = Server.CreateObject("adodb.stream")
set Data_newlife = Server.CreateObject("adodb.stream") '创建一个对象，文件以流的方式读取
Data_newlife.Type = 1 '设置文件读取方式Type 指定或返回的数据类型，可选参数为：
'adTypeBinary=1 为二进制方式
'adTypeText=2 为文本方式 Data_newlife.Mode =3 '文件读取模式（只读）
'1.Position 指定或返加对像内数据的当前指针。
'2.Size 返回对像内数据的大小。
'3.State 返加对像状态是否打开。 Data_newlife.Open '打开文件
Data_newlife.Write Request.BinaryRead(Request.TotalBytes)
Data_newlife.Position=0
RequestData =Data_newlife.Read
iFormStart = 1
iFormEnd = LenB(RequestData)
vbCrlf = chrB(13) & chrB(10)
sStart = MidB(RequestData,1, InStrB(iFormStart,RequestData,vbCrlf)-1)
'返回某字符串(iFormStart)在另一字符串(RequestData)中第一次出现的位置
'MidB 函数与包含在字符串中的字节数据一起使用。其参数不是指定字符数，而是字节数。
'这句的意思就是取得每个项目之间的分隔符
iStart = LenB (sStart)
iFormStart=iFormStart+iStart+1'分解项目
while (iFormStart + 2) < iFormEnd
iInfoEnd = InStrB(iFormStart,RequestData,vbCrlf & vbCrlf)+3
tStream.Type = 1
tStream.Mode =3
tStream.Open
'开始复制流
Data_newlife.Position = iFormStart
Data_newlife.CopyTo tStream,iInfoEnd-iFormStart
tStream.Position = 0
tStream.Type = 2
tStream.Charset ="gb2312"
sInfo = tStream.ReadText
tStream.Close '取得表单项目名称
iFormStart = InStrB(iInfoEnd,RequestData,sStart)
iFindStart = InStr(22,sInfo,"name=""",1)+6
iFindEnd = InStr(iFindStart,sInfo,"""",1)
sFormName = lcase(Mid (sinfo,iFindStart,iFindEnd-iFindStart))
'如果是文件
if InStr (45,sInfo,"filename=""",1) > 0 then
set theFile=new FileInfo
'取得文件名
iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10
iFindEnd = InStr(iFindStart,sInfo,"""",1)
sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
theFile.FileName=getFileName(sFileName)
theFile.FilePath=getFilePath(sFileName)
'取得文件类型
iFindStart = InStr(iFindEnd,sInfo,"Content-Type: ",1)+14
iFindEnd = InStr(iFindStart,sInfo,vbCr)
theFile.FileType =Mid (sinfo,iFindStart,iFindEnd-iFindStart)
theFile.FileStart =iInfoEnd
theFile.FileSize = iFormStart -iInfoEnd -3
theFile.FormName=sFormName
if not objFile.Exists(sFormName) then
objFile.add sFormName,theFile
end if
else
'如果是表单项目
tStream.Type =1
tStream.Mode =3
tStream.Open
Data_newlife.Position = iInfoEnd
Data_newlife.CopyTo tStream,iFormStart-iInfoEnd-3
tStream.Position = 0
tStream.Type = 2
tStream.Charset ="gb2312"
sFormValue = tStream.ReadText
tStream.Close
if objForm.Exists(sFormName) then
objForm(sFormName)=objForm(sFormName)&", "&sFormValue
else
objForm.Add sFormName,sFormValue
end if
end if
iFormStart=iFormStart+iStart+1
wend
RequestData=""
set tStream =nothing
End Subdim objForm,objFile'==========================================
'定义（取得表单里的内容）方法
'==========================================Public function Form(strForm)
strForm=lcase(strForm)
if not objForm.exists(strForm) then
Form=""
else
Form=objForm(strForm)
end if
end function'=========================================
'定义（取得文件）方法
'=========================================Public function File(strFile)
strFile=lcase(strFile)
if not objFile.exists(strFile) then
set File=new FileInfo
else
set File=objFile(strFile)
end if
end function'========================================
'定义取得文件的路径方法
'======================================== Private function GetFilePath(FullPath)
If FullPath <> "" Then '如果文件路径不为空
GetFilePath = left(FullPath,InStrRev(FullPath, "\")) '返回某字符串在字符串“\”中出现的（从结尾计起）的位置。也就是说将文件名前面的字符串赋值给GetFilePath
'例如：我现在上传的是本地的一个文件 其中路径为：C:\Documents and Settings\ASP无组件上传程序.zip 则把C:\Documents and Settings赋值给GetFilePath
Else
GetFilePath = ""
End If
End function'========================================
'定义文件名取得方法
'========================================
Private function GetFileName(FullPath)
If FullPath <> "" Then '如果文件路径不为空
GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1) '从字符串（路径）中返回指定数目（文件名之后的字符长度）的字符。注意+1 （加上的是“\”）
'例如：C:\Documents and Settings\ASP无组件上传程序.zip，则返回的是 ASP无组件上传程序.zip
Else
GetFileName = ""
End If
End function'========================================
'结束类
'========================================Private Sub Class_Terminate
if Request.TotalBytes>0 then
objForm.RemoveAll
objFile.RemoveAll
set objForm=nothing
set objFile=nothing
Data_newlife.Close
set Data_newlife =nothing
end if
End Sub
'----------------------------------------------------------------------------------------
End Class
'----------------------------------------------------------------------------------------
'=========================================
'文件信息类
'=========================================Class FileInfo
dim FormName,FileName,FilePath,FileSize,FileType,FileStart'=========================================
'类初始化
'========================================= Private Sub Class_Initialize
FileName = "" '文件名初始化为空
FilePath = "" '文件路径初始化为空
FileSize = 0 '文件大小初始化为0
FileStart= 0 '文件始位置初始化为0
FormName = "" '表单名初始化为空
FileType = "" '文件类型初始化为空
End Sub'========================================
'定义文件保存（方法）
'======================================== Public function SaveAs(FullPath)
dim dr,ErrorChar,i
SaveAs=true
if trim(fullpath)="" or FileStart=0 or FileName="" or right(fullpath,1)="/" then exit function
set dr=CreateObject("Adodb.Stream")
dr.Mode=3
dr.Type=1
dr.Open
Data_newlife.position=FileStart
Data_newlife.copyto dr,FileSize
dr.SaveToFile FullPath,2 '保存文件
dr.Close
set dr=nothing
SaveAs=false
end function
End Class
</SCRIPT>
[/CODE]
上传页面（upload.asp）
[QUOTE]
<form method="post" action="upload.asp" enctype="multipart/form-data">
<input type="file" name="file1" />
<input type="text" name="filename" value="default filename"/>
<input type="submit" value="Submit"/>
<input type="reset" value="Reset"/>
</form>
[/QUOTE]
DVBBS里的无组件上传其实就3个文件：头文件 upload_newlife.inc、上传文件处理 upfile.asp、上传页面 upload.asp，如果做过无组件上传的似乎对于 upfile.asp 里面的代码并不陌生，而对于upload_newlife.inc 里的比较头痛，先讲头文件吧 upload_newlife.inc，里面代码大家看着似乎很陌生其实归纳起来就是2个类：
无组件上传类（upload_newlife.inc）
1，主函数类 upload_newlife
①、主函数入口
②、取得表单里路径方法
③、取得文件的路径方法
④、取得文件方法
⑤、取得文件名方法
⑥、结束类
2、文件信息类 FileInfo
①、类初始化
②、文件保存方法
大家先看看主函数入口，代码很长主要是意思就是将表单提交的东西进行分析，分解其中的项目（表单项目，文件）并处理。大家注意到Request对象的BinaryRead方法，BinaryRead方法是对当前输入流进行指定字节数的二进制读取，代码中我们将BinaryRead读取的二进制转化为文本，输出出来，代码中我已经做了详细的注释相信大家都能看懂。
下面请大家看4个方法：
1、取得表单里路径方法
2、取得文件的路径方法
3、取得文件方法
4、取得文件名方法
代码中我已经将其详细表示出来了其中 objform 和 objfile 是对应的以上主函数类的容器分别可以取得主函数的分解项目，这些方法也是对于pfile.asp 里所调用的方法入口，其中取得文件方法还包含了文件类里的方法。
set File=new FileInfo
不知道大家看见没，方法之后就是主函数类upload_newlife里的结束类了，目的是释放资源；主函数类完了之后，就是文件信息类FileInfo，其中包含了无组件，上传最重要的地方就是保存文件到相应的路径下，定义文件保存（方法），大家发现没其实代码那么多大多数都是对表单提交上来进行处理，最后才是保存，文件信息类代码不多主要就是保存文件。
下面继续讲 upfile.asp 处理上传页面：
首先创建一个上传的对象 upload，接着就调用了类里面取得表单内容方法：upload.form("filepath")=""
然后调用了取得表单里路径的方法。
刚才凌风调试了下，出现了没指定上传路径，这里大家可以向代码里加上一段，例如formPath="../ASP/pic"加到set upload=new upload_newlife 下面，然后将
| if upload.form("filepath")="" then ''得到上传目录
HtmEnd "请输入要上传至的目录!"
set upload=nothing
response.end
else
formPath=upload.form("filepath") |
这段注释掉，就可以不通过表单里提交的指定路径而得到路径了。相同大家也可以保存这段代码，然后在上传页面（upload.asp）里加上一个文本域自己指定路径（注意：都是相对路径）
无论是什么文件都能上传关键在于自己向里面规定上传文件的类型
| fileexe=mid(formname,instrRev(forname,".")+1) '取得文件后缀 |
接着要做的是调用 SaveAs 方法保存文件
| if file.FileSize>0 then ''如果 FileSize > 0 说明有文件数据
file.SaveAs Server.mappath(formPath&file.FileName) '保存文件 |
这样保存上去的文件 其文件名是与原文件名一样的，这样如果有相同的文件名上传的话就会被覆盖掉，处理这样的手段很多原理就是替换掉以前的文件名。
| file.filename=year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&fileexe '这条代码就是其中的一种 |
下面怎么处理，可以按照自己的喜好，例如要将地址写入数据库。
Ａ：如果把其它类型的文件,改成扩展名为.jpg、.png、.bmp是否能上传？以二进制上传时能否判断是不是图形文件？
Ｑ：扩展名可以在程序里限制.是否为图形文件可以对文件代码进行分析。
-----------------------------------
Ａ：lcase个是函数吗,有什么作用
Ｑ：将字符串转化成小写
-----------------------------------
Ａ：关于外部提交表单问题
Ｑ：防止asp外部提交表单
可以使用2个函数检测。
Function PostCheck()
If Lcase(Request.ServerVariables("Request_Method"))="get" Then PostCheck=False
End Function
Function ChkPost()
dim server_v1,server_v2
chkpost=False
server_v1=Cstr(Request.ServerVariables("HTTP_REFERER"))
server_v2=Cstr(Request.ServerVariables("SERVER_NAME"))
If Mid(server_v1,8,Len(server_v2))<>server_v2 Then
chkpost=False
Else
chkpost=True
End If
End function
-----------------------------------
Ａ：哪段是指向文件的啊
Ｑ：表单中提交的，set file=upload.file(formName)
-----------------------------------
2005-08-08 16:48
