📄 qqcf_upfile.asp

📁 功　能： 1.系统分别为每个网站注册会员分配了一个推广链接
💻 ASP
字号:
<%
'==================================
' 乘风网站推广系统v3.83 Access版
' 制　作：乘　风
' 开发网站：乘风原创程序
' 网站网址: http://www.qqcf.com
' 程序演示：http://www.qqcf.com/?action=try
' 最新版本下载：http://www.qqcf.com/?action=down
' 使用帮助：http://www.qqcf.com/?action=help&help=cfwztg
' 声 明:	
' 本软件系免费程序,提供给个人免费使用。
' Access免费版缺少防止用户作弊的功能,如需要此功能请购买正式版本。
' 作者为付费版用户提供全面升级服务和技术支持,免费版用户提供有限的升级服务和技术支持。
' 免费版用户在程序首页保留乘风原创程序版权和链接。
' 未经作者许可禁止用于任何商业用途。
' 乘风其它作品：乘风多用户计数器Access版、MsSql版、Php版、.Net版，乘风电影程序、
'　　　　　　　 乘风网站推广系统Mssql版、乘风网址程序，乘风广告管理系统、乘风论坛等。
' 此段版权注释不会影响网页打开速度，请勿删除!
'                       2006年9月14日									
'===================================
%>
<!--#include FILE="QQCF_Conn.asp"-->
<!--#include FILE="QQCF_UpFile_Class.asp"-->
<%If Request("Action")="" Then%>
<body leftmargin="0" topmargin="0">
<%
If Session("CfWztgAdUser")="" Then
 Response.Write "请重新登录"
 Response.End
End If

Set Rs= Server.CreateObject("Adodb.RecordSet")
Sql="Select * From WWW_QQCF_COM_CfWztg_AdUser Where AdUser_Name='"&Session("CfWztgAdUser")&"'"
Rs.Open Sql,Conn,1,1
If Rs("Spare_Cent")=0 Then 
 Response.Write "剩余积分不够,请冲值后才能上传广告"
 Response.End
End If
%>
<form name="form1" method="post" action="?Action=upsave" enctype="multipart/form-data">
<input type=file name="img">
<input type=submit name="submit" value="上传"> 
</form>
<%End If%>


<%If Request("Action")="upsave" Then%>
<%
If UploadType=1 Then
 Const UpFileType="jpg|gif|swf" '允许的上传文件类型
 Const MaxFileSize="200" '允许的最大上传文件多少K
 FormName="img"'上传的表单名称
 SavePath="QQCF_AdPic"   '存放上传文件的目录
 If Right(SavePath,1)<>"/" Then SavePath=SavePath&"/" '在目录后加(/)
 FileName=year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)

 set upfile=new upfile_class ''建立上传对象
 upfile.NoAllowExt="asp;exe;htm;html;aspx;cs;vb;js;"	'设置上传类型的黑名单
 upfile.GetData (10240000)   '取得上传数据,限制最大上传10M

 Set File=UpFile.File(FormName)    
 If file.filesize<100 Then
  Response.Write "<script language='javascript'>" & VbCRlf
  Response.Write "alert('请先选择你要上传的文件！');" & VbCrlf
  Response.Write "history.go(-1);" & vbCrlf
  Response.Write "</script>" & VbCRLF
  Response.End
 End If
 If File.filesize>(MaxFileSize*1024) Then
  Response.Write "<script language='javascript'>" & VbCRlf
  Response.Write "alert('上传的文件大小超过限制！');" & VbCrlf
  Response.Write "history.go(-1);" & vbCrlf
  Response.Write "</script>" & VbCRLF
  Response.End
 End If
		
 FileExt=Lcase(File.FileExt)
 ForumUpload=Split(UpFileType,"|")
 For I=0 To Ubound(ForumUpload)
  If fileEXT=Trim(Forumupload(i)) Then
   EnableUpload=True
   Exit For
  End If
 Next
 If FileExt="asp" Or FileExt="asa" or FileExt="aspx" Then EnableUpload=False
 If EnableUpload=False Then
  Response.Write "<script language='javascript'>" & VbCRlf
  Response.Write "alert('对不起,不支持这类文件上传!');" & VbCrlf
  Response.Write "history.go(-1);" & vbCrlf
  Response.Write "</script>" & VbCRLF
  Response.End
 End If
		

 FilePath=SavePath&FileName&"."&FileExt
 FileName1=FileName&"."&FileExt

 UpFile.SaveToFile FormName,Server.MapPath(FilePath)
 Set UpFile=nothing

 Response.Write "<script language='javascript'>" & VbCRlf
 Response.Write "parent.document.form1.ad_2.value='" & "qqcf_adpic/"&FileName1 & "';" & vbcrlf
 Response.Write "alert('上传成功!');" & VbCrlf
 Response.Write "history.go(-1);" & vbCrlf
 Response.Write "</script>" & VbCRLF
End If


If UploadType=2 Then
 Dim Count
 on Error Resume Next
 Set Upload = Server.CreateObject("Persits.Upload") 
 Upload.OverwriteFiles = False   '不能复盖
 Upload.IgnoreNoPost = True
 Upload.SetMaxSize 200*1024, True	 '限制大小
 Count = Upload.Save
 If Err.Number = 8 Then 
  Response.Write "<script language='javascript'>" & VbCRlf
  Response.Write "alert('上传的文件大小超过限制！');" & VbCrlf
  Response.Write "history.go(-1);" & vbCrlf
  Response.Write "</script>" & VbCRLF
 Else 
  If Err <> 0 Then 
   Response.Write "错误信息: " & Err.Description 
  Else
   If Count < 1 Then 
    Response.Write "<script language='javascript'>" & VbCRlf
    Response.Write "alert('请先选择你要上传的文件!');" & VbCrlf
    Response.Write "history.go(-1);" & vbCrlf
    Response.Write "</script>" & VbCRLF
    Response.End
   End If
   For Each file in Upload.Files	'列出所有上传文件
	FileExt = Replace(File.ext,".","")
	
    If  CheckFileExt(FileExt)=False Then
     Response.Write "<script language='javascript'>" & VbCRlf
     Response.Write "alert('文件格式不正确!');" & VbCrlf
     Response.Write "history.go(-1);" & vbCrlf
     Response.Write "</script>" & VbCRLF
	 Response.End
    End If
    '文件变量付值
    FileName1=year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&"."&FileExt
    FileName="QQCF_AdPic/"&FileName1
    File.saveas Server.MapPath(FileName)	'上传保存文件
    Response.Write "<script language='javascript'>" & VbCRlf
    Response.Write "parent.document.form1.ad_2.value='" & "qqcf_adpic/"&FileName1 & "';" & vbcrlf
    Response.Write "alert('上传成功!');" & VbCrlf
    Response.Write "history.go(-1);" & vbCrlf
    Response.Write "</script>" & VbCRLF
   Next
  End If 
 End If
 Set Upload =Nothing
End If


Function FixName(UpFileExt)
	If IsEmpty(UpFileExt) Then Exit Function
	FixName = Lcase(UpFileExt)
	FixName = Replace(FixName,Chr(0),"")
	FixName = Replace(FixName,".","")
	FixName = Replace(FixName,"asp","")
	FixName = Replace(FixName,"asa","")
	FixName = Replace(FixName,"aspx","")
	FixName = Replace(FixName,"cer","")
	FixName = Replace(FixName,"cdx","")
	FixName = Replace(FixName,"htr","")
End Function

Function CheckFileExt(FileExt)
	Dim ForumUpload,i
	ForumUpload="jpg,gif,swf"
	ForumUpload=Split(ForumUpload,",")
	CheckFileExt=False
	For i=0 to UBound(ForumUpload)
		If LCase(FileExt)=Lcase(Trim(ForumUpload(i))) Then
			CheckFileExt=True
			Exit Function
		End If
	Next
End Function
%>
<%End If%>
⌨️ 快捷键说明

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