虚拟主机Asp无组件文件上传到租用服务器空间的实例

1.库文件(upload.inc.asp)
<%
Dim oUpFileStream

创新互联专注于成都网站设计、做网站、网页设计、网站制作、网站开发。公司秉持“客户至上,用心服务”的宗旨,从客户的利益和观点出发,让客户在网络营销中找到自己的驻足之地。尊重和关怀每一位客户，用严谨的态度对待客户，用专业的服务创造价值，成为客户值得信赖的朋友，为客户解除后顾之忧。

Class UpFile_Class

Dim Form,File,Version,Err

private Sub Class_Initialize
Version = "无组件上传类 Version V1.0"
Err = -1
End Sub

private Sub Class_Terminate
'清除变量及对像
If Err < 0 Then
Form.RemoveAll
Set Form = Nothing
File.RemoveAll
Set File = Nothing
oUpFileStream.Close
Set oUpFileStream = Nothing
End If
End Sub

public Sub GetData (RetSize)
'定义变量
Dim RequestBinDate,sSpace,bCrLf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,oFileInfo
Dim iFileSize,sFilepath,sFileType,sFormValue,sFileName
Dim iFindStart,iFindEnd
Dim iFormStart,iFormEnd,sFormName
'代码开始
If Request.TotalBytes < 1 Then
Err = 1
Exit Sub
End If
If RetSize > 0 Then
If Request.TotalBytes > RetSize Then
Err = 2
Exit Sub
End If
End If
Set Form = Server.CreateObject ("Scripting.Dictionary")
Form.CompareMode = 1
Set File = Server.CreateObject ("Scripting.Dictionary")
File.CompareMode = 1
Set tStream = Server.CreateObject ("ADODB.Stream")
Set oUpFileStream = Server.CreateObject ("ADODB.Stream")
oUpFileStream.Type = 1
oUpFileStream.Mode = 3
oUpFileStream.Open
oUpFileStream.Write Request.BinaryRead (Request.TotalBytes)
oUpFileStream.position = 0
RequestBinDate = oUpFileStream.Read
iFormEnd = oUpFileStream.Size
bCrLf = ChrB (13) & ChrB (10)
'取得每个项目之间的分隔符
sSpace = MidB (RequestBinDate,1, InStrB (1,RequestBinDate,bCrLf)-1)
iStart = LenB (sSpace)
iFormStart = iStart+2
'分解项目
Do
iInfoEnd = InStrB (iFormStart,RequestBinDate,bCrLf & bCrLf)+3
tStream.Type = 1
tStream.Mode = 3
tStream.Open
oUpFileStream.position = iFormStart
oUpFileStream.CopyTo tStream,iInfoEnd-iFormStart
tStream.position = 0
tStream.Type = 2
tStream.CharSet = "gb2312"
sInfo = tStream.ReadText
'取得表单项目名称
iFormStart = InStrB (iInfoEnd,RequestBinDate,sSpace)-1
iFindStart = InStr (22,sInfo,"name=""",1)+6
iFindEnd = InStr (iFindStart,sInfo,"""",1)
sFormName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
'如果是文件
If InStr (45,sInfo,"filename=""",1) > 0 Then
Set oFileInfo = new FileInfo_Class
'取得文件属性
iFindStart = InStr (iFindEnd,sInfo,"filename=""",1)+10
iFindEnd = InStr (iFindStart,sInfo,"""",1)
sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
oFileInfo.FileName = Mid (sFileName,InStrRev (sFileName, "\")+1)
oFileInfo.Filepath = Left (sFileName,InStrRev (sFileName, "\")+1)
oFileInfo.FileExt = Mid (sFileName,InStrRev (sFileName, ".")+1)
iFindStart = InStr (iFindEnd,sInfo,"Content-Type: ",1)+14
iFindEnd = InStr (iFindStart,sInfo,vbCr)
oFileInfo.FileType = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
oFileInfo.FileStart = iInfoEnd
oFileInfo.FileSize = iFormStart -iInfoEnd -2
oFileInfo.FormName = sFormName
file.add sFormName,oFileInfo
else
'如果是表单项目
tStream.Close
tStream.Type = 1
tStream.Mode = 3
tStream.Open
oUpFileStream.position = iInfoEnd
oUpFileStream.CopyTo tStream,iFormStart-iInfoEnd-2
tStream.position = 0
tStream.Type = 2
tStream.CharSet = "gb2312"
sFormValue = tStream.ReadText
If Form.Exists (sFormName) Then
Form (sFormName) = Form (sFormName) & ", " & sFormValue
else
form.Add sFormName,sFormValue
End If
End If
tStream.Close
iFormStart = iFormStart+iStart+2
'如果到文件尾了就退出
Loop Until (iFormStart+2) = iFormEnd
RequestBinDate = ""
Set tStream = Nothing
End Sub
End Class

'文件属性类
Class FileInfo_Class
Dim FormName,FileName,Filepath,FileSize,FileType,FileStart,FileExt
'保存文件方法
public Function SaveToFile (path)
On Error Resume Next
Dim oFileStream
Set oFileStream = CreateObject ("ADODB.Stream")
oFileStream.Type = 1
oFileStream.Mode = 3
oFileStream.Open
oUpFileStream.position = FileStart
oUpFileStream.CopyTo oFileStream,FileSize
oFileStream.SaveToFile path,2
oFileStream.Close
Set oFileStream = Nothing
if Err.Number<>0 then
SaveToFile=err.number&"**"&Err.descripton
else
SaveToFile="ok"
end if
End Function

'取得文件数据
public Function FileDate
oUpFileStream.position = FileStart
FileDate = oUpFileStream.Read (FileSize)
End Function
End Class
%>

2.处理用户提交后的页面(upload.asp)

<% dim upload,file,formName,formpath,filename,fileExt dim ranNum call UpFile() '===========无组件上传(upload_0)==================== sub UpFile() set upload=new UpFile_Class '建立上传对象 upload.GetData (500*1024) '取得上传数据,此处即为500 K if upload.err > 0 then select case upload.err case 1 Response.Write "请先选择你要上传的文件　[ 重新上传 ]" case 2 Response.Write "图片大小超过了限制 500 K　[ 重新上传 ]" end select exit sub else formpath=upload.form("filepath") '文件保存目录,此目录必须为程序可读写 if formpath="" then formpath="rwdata/" end if '在目录后加(/) if right(formpath,1)<>"/" then formpath=formpath&"/" end if for each formName in upload.file '列出所有上传了的文件 set file=upload.file(formName) '生成一个文件对象 if file.filesize<100 then response.write "请先选择你要上传的图片　[ 重新上传 ]" response.end end if fileExt=lcase(file.FileExt) if CheckFileExt(fileEXT)=false then response.write "文件格式不正确　[ 重新上传 ]" response.end end if 'randomize ranNum=int(90000*rnd)+10000 filename=formpath&year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&ranNum&"."&fileExt if file.FileSize>0 then '如果 FileSize > 0 说明有文件数据 result=file.SaveToFile(Server.mappath(filename)) '保存文件 if result="ok" then response.write formName&" upload OK, had saved to "&filename&" " else response.write formName&" upload Fail,"&result&" " end if end if set file=nothing next set upload=nothing end if end sub '判断文件类型是否合格 private Function CheckFileExt (fileEXT) dim Forumupload Forumupload="gif,jpg,bmp,jpeg" Forumupload=split(Forumupload,",") for i=0 to ubound(Forumupload) if lcase(fileEXT)=lcase(trim(Forumupload(i))) then CheckFileExt=true exit Function else CheckFileExt=false end if next End Function %>

3.HTML 表单(upload.html)

请选择要上传的文件

本文题目：虚拟主机Asp无组件文件上传到租用服务器空间的实例
文章分享：http://cdxtjz.cn/article/eechcg.html