⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 upload.asp1##11

📁 非常好的源码 非常好的源码 非常好的源码
💻 ASP1##11
字号:
🔍 
<!--#include file=admin_login_check.asp-->
<%
Dim const_txl_HomeUrl,errstr,orderto,content
Dim intro,filename,maxphotoSize,upflag,newphotoid,photoSize,photoFormat

dim lid,cid
lid=TRim(Request("lid"))
cid=TRim(Request("cid"))

intro=""
orderto=""
content=""
filename=""
const const_uploadcomponent=1	'1无组件,2为FileUp组件,3为ABCUPload
upflag=False

			set rs=server.CreateObject("adodb.recordset")
			sql="select * from ulist  WHERE lid=" & lid&" and cid='" & cid&"'"
			rs.open sql,conn,1,1
			if not (rs.bof and rs.eof)  then 

const_PhotoFormat=rs("format")
maxphotoSize=rs("size")
files=rs("upfile")
const_txl_HomeUrl="../"&files
			end if
		Rs.close
		set rs=nothing

Call main


Sub main
	Dim tmpstr
	if outsitesubmit Then
		Call printerror ("上传文件出错","<li>请不要外部提交数据！</li>",779)
		exit sub
	End If
	Select Case	const_uploadcomponent	
	'1无组件,2为FileUp组件,3为ABCUPload
		Case 1
			Call upload_5xsoft_upload
		Case 2:
			Call FileUp_upload
		Case 3:
			Call ABC_upload
	end select 
	
	intro=htmlEncode(intro)
    content=htmlEncode(content)
    intro=Replace(intro,"'","''")	
	content=Replace(content,"'","''")
	orderto=Replace(orderto,"'","''")
	If upflag=False Then
		Exit Sub
	Else
		Call SaveToDataBase
	End If
	tmpstr="<li>恭喜你，上传文件成功！</li>"&Vbcrlf
	tmpstr=tmpstr&"<li>刚才你上传文件的主题是<font color='red'>"&intro&"</font></li>"
	tmpstr=tmpstr&"<li>刚才你上传文件的路径是<font color='red'>"&filename&"</font></li>"
	tmpstr=tmpstr&"<li>回<a href='admin_utitle.asp?lid="&lid&"&cid="&cid&"'>上传管理</a></li>"
	Call printsuc("上传成功",tmpstr,779)
End Sub
Sub upload_5xsoft_upload
%>
<!--#include file=upload_5xsoft.inc-->
<%
	on error resume next
	Dim upload,file,formName,FileExp,iCount,TotalSize
	set upload=new upload_5xsoft
	If not isobject(upload) Then
		Call printerror ("上传文件出错","<li>服务器不支持该上传对象！</li>",779)
		upflag=False
		exit sub
	End If
	intro=Trim(upload.form("intro"))
	content=Trim(upload.form("content"))
	If  intro="" Then
		Call printerror ("上传文件出错","<li>请输入文件说明！</li>",779)
		upflag=False
		exit sub
	End If
	iCount=0
	For each formName in upload.objFile 
		Set file=upload.file(formName)  
		If file.FileSize>0 Then         
			FileExp=Right(file.FileName,Len(file.FileName)-InstrRev(file.FileName,".")+1)
			If not CheckExp(FileExp) Then
				Call printerror ("上传文件出错","<li>当前设置不能上传该格式的文件！</li>",779)
				upflag=False
				exit sub
			End IF
			photoFormat=FileExp
			TotalSize=file.FileSize/1024
			photoSize=TotalSize
			If TotalSize>maxphotoSize Then
				Call printerror ("上传文件出错","<li>所传文件已经大于设定的允许值<font color=red>"&maxphotoSize&"K</font>，当前所传文件大小"&TotalSize&"Kb！</li>",779)
				upflag=False
				exit sub
			End If
			filename=GetRndFileName&FileExp
			File.SaveAs Server.mappath(const_txl_HomeUrl&const_photoup_path&filename)   ''保存文件
			iCount=iCount+1
		Else 
			Call printerror ("上传文件出错","<li>上传数据为空，请检查该文件是否存在！</li>",779)
			upflag=False
			exit sub
		 End If
		Set File=nothing
	next
	set upload=nothing  ''删除此对象
	upflag=True
End Sub

Sub FileUp_upload
	'说明：此组件有个很大的缺点,文件大小只能在上传完成之后才能读出来,
	'因此文件大于规定大小时,文件已经上传,但是数据库中并不会添加记录
	on error resume next
	Dim FileUp,FileExp,filehead,NewFileName,intstart,intend,TotalSize
	set FileUp=Server.CreateObject("FileUp.upload")
	If Not IsObject(FileUp) Then
		Call printerror ("上传文件出错","<li>服务器不支持该上传对象！</li>",779)
		upflag=False
		exit sub
	End If
	
	filehead=FileUp.Userfilename
	intstart=Instr(filehead,"name="&chr(34)&"intro"&chr(34))+len("name="&chr(34)&"intro"&chr(34))
	intro=mid(filehead,intstart,Len(filehead)-Instr(Right(filehead,intstart),"------"))
	intro=left(intro,Instr(intro,"---")-1)
	intro=Replace(intro,vbcrlf,"")
	intro=Trim(Intro)
	NewFileName=Mid(fileup.UserFilename,InstrRev(Replace(Fileup.UserFilename,"/","\"), "\") + 1)
	If  intro="" Then
		Call printerror ("上传文件出错","<li>请输入文件说明！</li>",779)
		upflag=False
		exit sub
	End If
	FileExp=Right(NewFileName,Len(NewFileName)-InstrRev(NewFileName,".")+1)
	If not CheckExp(FileExp) Then
			Call printerror ("上传文件出错","<li>当前设置不能上传该格式的文件！</li>",779)
			upflag=False
			exit sub
	End IF
	filename=GetRndFileName&FileExp
	FileUp.SaveAs Server.mappath(const_txl_HomeUrl&const_photoup_path&filename)   ''保存文件
	If FileUp.TotalBytes <> 0 then
		TotalSize=FileUp.TotalBytes/1024
		photoSize=TotalSize
		If TotalSize>maxphotoSize Then
			Call printerror ("上传文件出错","<li>所传文件已经大于设定的允许值<font color=red>"&maxphotoSize&"K</font>，当前所传文件大小"&TotalSize&"Kb！</li>",779)
			upflag=False
			exit sub
		End If
		photoFormat=FileExp
		photoSize=TotalSize
		upflag=True
	Else
		Call printerror ("上传文件出错","<li>上传数据为空，请检查该文件是否存在！</li>",779)
		upflag=False
		Exit sub
	End if
End Sub



Sub ABC_upload
	Dim theForm,fileup,imagesize,extname
	Set theForm = Server.CreateObject("ABCUpload4.XForm")
	If Not IsObject(theForm) Then
		Call printerror ("上传文件出错","<li>服务器不支持该上传对象！</li>",779)
		upflag=False
		exit sub
	End If
	theForm.AbsolutePath = True
	theForm.Overwrite = True
	set fileup=theForm("filexx")(1)
	intro=Trim(theform("intro"))
	If  intro="" Then
		Call printerror ("上传文件出错","<li>请输入文件说明！</li>",779)
		upflag=False
		exit sub
	End If
	if  fileup.FileExists then
		extname="."&fileup.rawfiletype
	end if
	imagesize=fileup.RawLength/1024
	If imagesize=0 Then
		Call printerror ("上传文件出错","<li>上传数据为空，请检查该文件是否存在！</li>",779)
		upflag=False
		Exit sub
	End if
	If not CheckExp(extname) Then
			Call printerror ("上传文件出错","<li>当前设置不能上传该格式的文件！</li>",779)
			upflag=False
			exit sub
	End IF
	If imagesize>maxphotoSize Then
		Call printerror ("上传文件出错","<li>所传文件已经大于设定的允许值<font color=red>"&maxphotoSize&"K</font>，当前所传文件大小"&TotalSize&"Kb！</li>",779)
		upflag=False
		exit sub
	End If
	filename=GetRndFileName&extname
	fileup.Save Server.mappath(const_txl_HomeUrl&const_photoup_path&filename)   ''保存文件
	photoSize=imagesize
	photoFormat=extname
	upflag=True
End Sub


Sub SaveToDataBase
			set rs=server.CreateObject("adodb.recordset")
			sql="select * from ufile where lid='"&lid&"' and cid='"&cid&"' order by pid asc"
			rs.open sql,conn,1,3
			if not (rs.bof and rs.eof)  then 
				rs.MoveLast
				pid=rs("pid")
			end if
	Rs.addnew
		filename=files&filename&""
		Rs("url")=filename
		Rs("name")=intro
		Rs("size")=photoSize
		Rs("format")=photoFormat
		Rs("title")=content
		Rs("lid")=lid
		Rs("cid")=cid
		Rs("pid")=pid+1
		

	Rs.Update
	Rs.close
	Set Rs=nothing
	newphotoid=id
End Sub

Rem 文件扩展名检测
Function CheckExp(TheFileExp)
	fileformat=".asp,.jsp,.php,.aspx,.mdb,.js,.cgi"
	Dim defaultphotoFormat,i
	TheFileExp=lcase(TheFileExp)
	CheckExp=False
	If TheFileExp="" Then 
		CheckExp=False
		Exit Function
	End If

	fFormat=Split(fileformat,",")



	If Instr(const_photoFormat,",")>0 Then
		defaultphotoFormat=Split(const_photoFormat,",")
	Else
		defaultphotoFormat=const_photoFormat
	End If
	If IsArray(defaultphotoFormat) Then
		For i=0 To Ubound(defaultphotoFormat)
			If TheFileExp=lcase(defaultphotoFormat(i)) Then
				CheckExp=True
				Exit For
			End If
		Next
	Else
		If TheFileExp=defaultphotoFormat Then
			CheckExp=True
		End If
	End If

		For i=0 To Ubound(fFormat)
			If TheFileExp=lcase(fFormat(i)) Then
				CheckExp=False
				Exit For
			End If
		Next
End Function

Rem 得到随即文件名，时间加随机数，理论上不会重名
Function GetRndFileName()
	Dim tmpstr
	randomize
	tmpstr=Int(1000*rnd)
	'tmpstr=""&year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&tmpstr&"_t125_com"
	tmpstr=""&year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&tmpstr
	GetRndFileName=tmpstr
End Function
function printerror(errtitle,errstr,width) 
		Response.write "<br><table width='"&width&"' border=""0"" align=""center"" cellpadding=""2"" cellspacing=""1"" bgcolor=""#666666"">"&Vbcrlf
  		Response.write "  <tr>"&Vbcrlf
  		Response.write "    <td height=20 class='title'><font color='#FFFFFF'><b>"&errtitle&"</b></font></td>"&Vbcrlf
 		Response.write "   </tr>"&Vbcrlf
		Response.write "  <tr>" &Vbcrlf
    	Response.write "    <td bgcolor=""#FFFFFF"" class='content' style='line-height:1.8;'><b>产生错误的可能原因：</b><br>"&errstr&"</td>"&Vbcrlf
 		Response.write "  </tr>"&Vbcrlf
 		Response.write "  <tr>" &Vbcrlf
   		Response.write "    <td align=""center"" height=30 bgcolor=""#FFFFFF"">&lt;&lt; <a href=""javascript:history.back()"">返回上一页</a></td>"&Vbcrlf
  		Response.write "  </tr>"&Vbcrlf
		Response.write "</table><br>"&Vbcrlf
end function

Function htmlEncode(str)

	If len(str)>0 Then
		htmlEncode=Replace(Replace(Replace(str,">","&gt;"),"<","&lt;"),"""","&quot;")
	Else
		htmlEncode=str
	End If
End Function
function printsuc(suctitle,sucstr,width) 
		Response.write "<br><table width='"&width&"' border=""0"" align=""center"" cellpadding=""2"" cellspacing=""1"" bgcolor=""#666666"">"&Vbcrlf
  		Response.write "  <tr>"&Vbcrlf
  		Response.write "    <td height=20 class='title'><font color='#FFFFFF'><b>"&suctitle&"</b></font></td>"&Vbcrlf
 		Response.write "   </tr>"&Vbcrlf
		Response.write "  <tr>" &Vbcrlf
    	Response.write "    <td bgcolor=""#FFFFFF"" class='content' style='line-height:1.8;'><b>您可以选择以下操作：</b><br>"&sucstr&"</td>"&Vbcrlf
 		Response.write "  </tr>"&Vbcrlf
 		Response.write "  <tr>" &Vbcrlf
   		Response.write "    <td align=""center"" height=30 bgcolor=""#FFFFFF"">&lt;&lt; <a href=""javascript:history.back()"">返回上一页</a></td>"&Vbcrlf
  		Response.write "  </tr>"&Vbcrlf
		Response.write "</table><br>"&Vbcrlf
end function
%>

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -