upfilex.asp

obbs完全基于Dreamweaver 和EmEditor 下面完成.采用最好的可视结构,非常用利于修改,结构很明确.代码效少.管理非常简单

<!--#include file="CONN.ASP" -->
<%
Server.ScriptTimeOut=5000
dim Data_5xsoft

Class upload_5xsoft
  
dim objForm,objFile,Version

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 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
  Version="化境HTTP上传程序 Version 2.0"
  set objForm=Server.CreateObject("Scripting.Dictionary")
  set objFile=Server.CreateObject("Scripting.Dictionary")
  if Request.TotalBytes<1 then Exit Sub
  set tStream = Server.CreateObject("adodb.stream")
  set Data_5xsoft = Server.CreateObject("adodb.stream")
  Data_5xsoft.Type = 1
  Data_5xsoft.Mode =3
  Data_5xsoft.Open
  Data_5xsoft.Write  Request.BinaryRead(Request.TotalBytes)
  Data_5xsoft.Position=0
  RequestData =Data_5xsoft.Read 

  iFormStart = 1
  iFormEnd = LenB(RequestData)
  vbCrlf = chrB(13) & chrB(10)
  sStart = MidB(RequestData,1, InStrB(iFormStart,RequestData,vbCrlf)-1)
  iStart = LenB (sStart)
  iFormStart=iFormStart+iStart+1
  while (iFormStart + 10) < iFormEnd 
	iInfoEnd = InStrB(iFormStart,RequestData,vbCrlf & vbCrlf)+3
	tStream.Type = 1
	tStream.Mode =3
	tStream.Open
	Data_5xsoft.Position = iFormStart
	Data_5xsoft.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_5xsoft.Position = iInfoEnd 
		Data_5xsoft.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 Sub

Private Sub Class_Terminate  
 if Request.TotalBytes>0 then
	objForm.RemoveAll
	objFile.RemoveAll
	set objForm=nothing
	set objFile=nothing
	Data_5xsoft.Close
	set Data_5xsoft =nothing
 end if
End Sub
   
 
 Private function GetFilePath(FullPath)
  If FullPath <> "" Then
   GetFilePath = left(FullPath,InStrRev(FullPath, "\"))
  Else
   GetFilePath = ""
  End If
 End  function
 
 Private function GetFileName(FullPath)
  If FullPath <> "" Then
   GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1)
  Else
   GetFileName = ""
  End If
 End  function
End Class

Class FileInfo
  dim FormName,FileName,FilePath,FileSize,FileType,FileStart
  Private Sub Class_Initialize 
    FileName = ""
    FilePath = ""
    FileSize = 0
    FileStart= 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_5xsoft.position=FileStart
    Data_5xsoft.copyto dr,FileSize
    dr.SaveToFile FullPath,2
    dr.Close
    set dr=nothing 
    SaveAs=false
  end function
End Class

'判断文件类型是否合格
Private Function CheckFileExt (fileEXT)
dim Forumupload,i
Forumupload="gif,jpg,bmp,jpeg,png"
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


dim rs,sql,upload,user,upfiles,rsupfiles
set upload=new upload_5xsoft ''建立上传对象
user=request.cookies("renwen")("user")
upfiles=4
if user="" or request.cookies("renwen")("passedok")<>"ofdkjduy" then
response.Write("此页面为注册用户页,请注册!")
response.End()
end if
set rs=server.createobject("adodb.recordset")
sql="select time from upfile where datediff('d',time,Now())<1 and lb<>'face' order by id desc"
rs.open sql,conn,1,1
rsupfiles=rs.recordcount
sub uploadfileclass() '上传文件子程序
dim lb,file,formName,formPath,iCount,ranNum,fileExt,FileName,rs,Extarry,outcode
lb=upload.Form("lb")
'iCount=0
'if upload.form("filepath")="" then   ''得到上传目录
' HtmEnd "请输入要上传至的目录!"
' set upload=nothing
 'response.end
'else
' formPath=upload.form("filepath")
 ''在目录后加(/)
 'if right(formPath,1)<>"/" then formPath=formPath&"/" 
'end if
'for each formName in upload.objForm ''列出所有form数据
' response.write formName&"="&upload.form(formName)&"<br>"
'next
'response.write "<br>"
'for each formName in upload.objFile   ''列出所有上传了的文件
response.Write("<link href=""DEFAULT.css"" rel=""stylesheet"" type=""text/css""><body bgcolor=#FFFFFF text=#000000 topmargin=0 marginwidth=0 marginheight=0>")
 set file=upload.file("file1")    ''生成一个文件对象
  if file.FileSize>409600 then 
  response.Write("上传文件,超出大小!请重新上传.<a href=?lb="&lb&">返回</a>")
  exit sub
  end if
  if file.FileSize>0 then 
  
    randomize
    Extarry=split(file.FileName,".")
	fileExt=Extarry(ubound(Extarry))
    ranNum=int(90000*rnd)+10000
	if CheckFileExt(fileExt)=false then
    response.Write("文件类型不符.请注意上传规定的文件类型!<a href=?lb="&lb&">返回</a>")
	exit sub
	end if
	if rsupfiles>=upfiles and lb<>"face" then
    response.Write("你今天已经上传了 "&upfiles&" 个文件了,每天可以上传 "&upfiles&" 个文件")
    exit sub
    end if
'    FileName=formPath&year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&ranNum&"."&fileExt
'    response.write file.FilePath&file.FileName&" ("&file.FileSize&") => "&formPath&File.FileName&" 成功!<br>"
     if lb="face" then '如果是上头像,以用户名为文件名,改变上传目录
     FileName="upface/"&user&"."&fileExt '确定上传目录,上传文件名
     outcode="头像上传结束! [<a href=?lb="&lb&">返回</a>]<script>parent.document.form1.myface.value='"&filename&"'</script>"
	 else
     FileName="upimg/"&year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&ranNum&"."&fileExt '确定上传目录,上传文件名
     outcode=" 1个文件上传结束! [<a href=?lb="&lb&">返回</a>]<script>parent.document.FORM1.ly.value+='[IMG]" &filename& "[/IMG]'</script>"
     end if
	file.SaveAs Server.MapPath(FileName)
    else
    response.Write("请选择要上传的文件.<a href=?lb="&lb&">返回</a>")
    exit sub
   end if
'看是否有上传头像 如果有-更新数据,如否添加记录
   if lb="face" and (not conn.execute("select user from upfile where user='"&user&"' and lb='face'").eof) then
     conn.execute("update upfile set [user]='"&user&"',[pic]='"&FileName&"',[time]=now(),[size]='"&file.FileSize&"',[lb]='"&lb&"',[F_type]='"&fileExt&"' where user='"&user&"' and lb='face'")
   else
     conn.execute("insert into upfile([user],[pic],[time],[size],[lb],[F_type]) values ('"&user&"','"&FileName&"',now(),'"&file.FileSize&"','"&lb&"','"&fileExt&"')")
   end if     
   response.write(outcode)
   set file=nothing
   set upload=nothing  ''删除此对象
end sub

if upload.Form("Submit")<>"" then
call uploadfileclass()
else
set upload=nothing
%>
<html>
<head>
<title>文件上传</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<link href="DEFAULT.css" rel="stylesheet" type="text/css">
</head>
<body bgcolor="#FFFFFF" text="#000000" topmargin="0" marginwidth="0" marginheight="0">
<%
if rsupfiles>=upfiles and request.QueryString("lb")<>"face" then
response.Write("你今天已经上传了 "&upfiles&" 个文件了,每天最多上传 "&upfiles&" 个文件")
else
%>
<form name="form1" method="post" action="upfilex.asp" enctype="multipart/form-data" >
  <table width="542" border="0" cellpadding="0" cellspacing="0">
    <tr> 
      <td width="206"> 
        <input type="file" name="file1" value=""></td>
      <td width="336"> 
        <input type="submit" name="Submit" value="提交">
        <input type="hidden" name="upcount" value="1">
        <input name="lb" type="hidden" id="lb" value="<%=request.QueryString("lb")%>">
        你还可上传:<b><%=upfiles-rsupfiles%></b>个文件 每天<b><%=upfiles%></b>文件 每个400K</td>
    </tr>
  </table>
</form>
<%end if%>
</body>
</html>
<%end if%>