📄 index.asp

📁 网人分类信息5.0商业版。非常优秀的分类信息系统。比较少见。
💻 ASP
📖 第 1 页 / 共 2 页
字号:
12 下一页
<!--#include FILE="../../Inc/Conn.asp"-->
<!--#include file="../../Inc/Cls.Common.asp"-->
<!--#include file="../Cook.asp"-->
<%Call FlagU()%>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>上传模块</title>
</head>
<body>
<style>
body{font-size:12px;color:#333333;line-height:150%}
input{border:1px #999999 solid;height:20px}
.input{background:#F3FBF0}
.radio{border:0px}
</style>
<script>
// 显示无模式对话框
function ShowDialog(url, width, height) {
	var arr = showModalDialog(url, window, "dialogWidth:" + width + "px;dialogHeight:" + height + "px;help:no;scroll:no;status:no");
}

function up(){
updiv.style.display="";
downdiv.style.display="none";
}
function down(){
updiv.style.display="none";
downdiv.style.display="";
}
function other(){
updiv.style.display="none";
downdiv.style.display="none";
}
function FormPost() {  
  if(document.myform.UP1.checked==true && document.myform.MyFile.value == ""){
	alert("\·请选择待上传的文件");
	return false;
	}
  if(document.myform.UP2.checked==true && document.myform.FileUrl.value == ""){
    alert("\·请输入待下载文件的URL地址");
	return false;
	}
}
</script>
<%
'index.asp?Type=1&User=1
'uUpType 1分类信息，2文章，3店铺图，4店铺视频，5认证，6头像，7广告 ,8商品/礼品，9优惠券
'uUser 1后台、2代理 3用户 
'uRz   适用于用户认证上传 0为实名认证 >0为店铺营业执照认证
'uRzType 0店铺标志上传

If Request("Type") = "" OR Request("User") = "" Then Response.write "操作错误<br><a href=# Onclick=""javascript:history.back()"">返回</a>":Response.end
Dim Upload,uSavePath,uUpType,uSaveDir,u_SaveDir,u_SaveFilter,u_SaveMaxSize,uUser,uUserName,uUP,uSpath,uSmpath,uFileName,uFileUrl,sqlPath,sqlSize,SPicPath
Dim u_Filter,uI,UpErr,RemoteErr,uFileNo,u_uFilter,uRz,zUse,uRzType

If Request.ServerVariables("REQUEST_METHOD") = "POST" Then
  '有组件形式：第一次使用需要右键“Upload.sct”文件 - 注册
  'Set Upload = Server.CreateObject("Rimifon.Upload")
  Set Upload = GetObject("script:" & Server.MapPath("Upload.sct"))
  Upload.ReadForm
  uRz = Upload.Form("Rz")
  If uRz = "" Then uRz = -1
  uRzType = Upload.Form("RzType")
  If uRzType = "" Then uRzType = -1
  uUP = Upload.Form("UP")
  uUser = Upload.Form("User")
  uUpType = Upload.Form("Type")                '上传类型
  If uUser = "" OR uUpType = "" Then Response.write "操作错误<br><a href=# Onclick=""javascript:history.back()"">返回</a>":Response.end
  uSaveDir = WR_UpLoad(0)&"/"&GetSaveDir(uUpType,1)&WRMPS.SaveTimeDir()
  uSavePath = "../../"&uSaveDir                '保存路径
  Call WRMPS.FsoBegin()
  Call WRMPS.CreFolder(uSavePath)
  If Int(WR_UpLoad(20)) > 0 and uRzType <> 0 Then
    Select Case Int(uUpType)
      Case 1,2,3,8,9
	    Call WRMPS.CreFolder(uSavePath&"S/")
    End Select
  End If
  Call WRMPS.FsoEnd()
  Select Case Int(uUP)
    Case 1
      Upload.Filter = GetSaveDir(uUpType,2)        '文件类型
      Upload.MaxSize = GetSaveDir(uUpType,3)*1024  '文件大小
	  If Upload.Field.MyFile.FileSize > Upload.MaxSize Then
	    Response.Write "上传文档大小超过限制<br><a href=# Onclick=""javascript:history.back()"">返回</a>"
		Response.end
	  End If
      Upload.SaveFile(uSavePath)                   '写入文件
	  uSpath = uSavePath&Upload.Field.MyFile.FileName
	  uSmpath = uSavePath&"S/"&Upload.Field.MyFile.FileName
	  sqlPath = GetSaveDir(uUpType,1)&WRMPS.SaveTimeDir()&Upload.Field.MyFile.FileName
	  sqlSize = Upload.Field.MyFile.FileSize

      If Upload.Field.MyFile.Message <> "" Then
        Upload.Dispose
        Set Upload = Nothing
	  End If

	Case 2
	  uFileUrl = Upload.Form("FileUrl")
	  uFileName = GetFileName(uFileUrl,GetSaveDir(uUpType,2))
	  uSpath = uSavePath&uFileName
	  uSmpath = uSavePath&"S/"&uFileName
	  sqlPath = GetSaveDir(uUpType,1)&WRMPS.SaveTimeDir()&uFileName
	  sqlSize= SaveRemoteFile(uSpath,uFileUrl,GetSaveDir(uUpType,3))
      If sqlSize = 0 Then
	    Response.Write "操作错误<br><a href=# Onclick=""javascript:history.back()"">返回</a>"
		Response.end
	  End If
  End Select
  If Int(WR_UpLoad(20)) > 0 and uRzType <> 0 Then '缩略图
    Select Case Int(uUpType)
      Case 1,2,3,8,9
	    Call CreateThumbs(uSpath,uSmpath)
    End Select
  End If
  If Int(WR_UpLoad(25)) > 0 and uRzType <> 0 Then '水印
    Select Case Int(uUpType)
      Case 1,2,3,8
	    Call AddWaterMark(uSpath)
    End Select
  End If
  
  Select Case Int(uUser)
    Case 1
	  uUserName = Request.Cookies("Admin")("Admin")
	Case Else
	  uUserName = MemName
  End Select
  Call DBConnBegin()
  If Int(uUpType) = 5 Or (Int(uUpType) = 3 and Int(uRzType) = 0) Then zUse = 1 Else zUse = 0
  Conn.Execute("Insert into WM_UpFile(WM_User,WM_UserType,WM_SavePath,WM_FileSize,WM_Time,WM_UpType,WM_Use)values('"&uUserName&"',"&uUser&",'"&WRMPS.CheckStr(WR_Setting(3)&WR_UpLoad(0)&"/"&sqlPath,4)&"',"&sqlSize&","&ConnTime&","&uUpType&","&zUse&")")
  If Int(uUpType) = 5 And Int(uUser) = 3 and Int(uRz) >=0 Then
    Select Case Int(uRz)
      Case 0
		Conn.Execute("Update WM_Member Set WM_IDPic = '"&WRMPS.CheckStr(WR_Setting(3)&WR_UpLoad(0)&"/"&sqlPath,4)&"' Where WM_ID = "&MemID&" and WM_RZID=0")
      Case Else
		Conn.Execute("Update WM_Company Set WM_BLPic = '"&WRMPS.CheckStr(WR_Setting(3)&WR_UpLoad(0)&"/"&sqlPath,4)&"',WM_ClaimUser='"&MemName&"',WM_RZBL=0,WM_Domain=null,WM_Eng=null,WM_SiteTemp=null,WM_EndTime=null Where WM_ID="&Int(uRz)&" and (WM_RZBL = 0 or WM_EndTime < "&ConnTime&")")
    End Select
  End If
  If Int(uUpType) = 3 And Int(uUser) = 3 and Int(uRz) >= 0 and Int(uRzType) = 0 Then
	Conn.Execute("Update WM_Company Set WM_Logo = '"&WRMPS.CheckStr(WR_Setting(3)&WR_UpLoad(0)&"/"&sqlPath,4)&"' Where WM_ID="&Int(uRz))
  End If
  Call DBConnEnd()
  SPicPath = WR_Setting(3)&WR_UpLoad(0)&"/"&sqlPath
  If Int(WR_UpLoad(20)) > 0 and uRzType <> 0 Then '缩略图
    Select Case Int(uUpType)
      Case 1,2,3,8,9
	    SPicPath = Replace(SPicPath,split(SPicPath,"/")(UBound(split(SPicPath,"/"))),"S/"&split(SPicPath,"/")(UBound(split(SPicPath,"/"))))
    End Select
  End If
 
  'uUpType 1分类信息，2文章，3店铺图，4店铺视频，5认证，6头像，7广告 ,8商品/礼品，9优惠券
  Select Case Int(uUser)
    Case 1
      Select Case Int(uUpType)
        Case 6
	      Response.Write "<script>parent.upother('"&WR_Setting(3)&WR_UpLoad(0)&"/"&sqlPath&"')</script>"
        Case 7
	      Response.Write "<script>parent.upad('"&WR_Setting(3)&WR_UpLoad(0)&"/"&sqlPath&"')</script>"
        Case 8
	      Response.Write "<script>parent.upshop('"&SPicPath&"')</script>"
	    Case 9
	      Response.Write "<script>parent.upcou('"&SPicPath&"','"&WR_Setting(3)&WR_UpLoad(0)&"/"&sqlPath&"')</script>"
	    Case Else
	      Response.Write "<script>parent.upback('"&SPicPath&"','"&WR_Setting(3)&WR_UpLoad(0)&"/"&sqlPath&"')</script>"
      End Select
	Case Else
      Select Case Int(uUpType)
        Case 1,2  '会中中心，用编辑器
	      Response.Write "<script>parent.upback('"&SPicPath&"','"&WR_Setting(3)&WR_UpLoad(0)&"/"&sqlPath&"')</script>"
        Case 3,4  '前台 传大图和小图
	      If uRzType <> 0 Then
		    Response.Write "<script>parent.upcom('"&SPicPath&"','"&WR_Setting(3)&WR_UpLoad(0)&"/"&sqlPath&"')</script>"
		  Else
	        Response.Write "<body style='margin:0'><script>window.open('../../Member/User_Site.asp?Action=Reh','_parent')</script><img src="&SPicPath&" width=160 height=60><br>上传完成：<a href=../../Member/User_Site.asp?Action=Reh target=_parent>刷新店铺文件并返回</a>"
		  End If
	    Case 6  '传一个图
	      Response.Write "<script>parent.upother('"&WR_Setting(3)&WR_UpLoad(0)&"/"&sqlPath&"')</script>"
	    Case 7
	      Response.Write "<script>parent.upad('"&WR_Setting(3)&WR_UpLoad(0)&"/"&sqlPath&"')</script>"
	    Case 5
	      Response.Write "<body style='margin:0'>请等待认证审核..."
	    Case 9
	      Response.Write "<script>parent.upcou('"&SPicPath&"','"&WR_Setting(3)&WR_UpLoad(0)&"/"&sqlPath&"')</script>"
      End Select
  End Select
  Upload.Dispose
  Set Upload = Nothing

Else
  Response.write "<form name='myform' enctype='multipart/form-data' method='post' onSubmit='return FormPost()'>" & vbCrLf
  Response.write "<input type=hidden name=Type value="&Request("Type")&">" & vbCrLf
  Response.write "<input type=hidden name=User value="&Request("User")&">" & vbCrLf
  Response.write "<input type=hidden name=Rz value="&Request("Rz")&">" & vbCrLf
  Response.write "<input type=hidden name=RzType value="&Request("RzType")&">" & vbCrLf
  Response.write "<div><input type=radio name=UP value=1 class=radio id=UP1 checked onclick=up()>本地上传"
  If Request("Type") <> 5 Then Response.write "　<input type=radio name=UP id=UP2 value=2 class=radio onclick=down()>远程下载"
  If Request("User") = 1 Then Response.write "　<input type=radio name=UP id=UP3 value=3 class=radio onclick='javascript:other();ShowDialog(""UploadFile.asp?Type="&Request("Type")&"&User="&Request("User")&""",""self"",""355"",""510"")'>从已上传文件中选择</div>" & vbCrLf
  Response.write "<div id=updiv><input name='MyFile' type='file' class=input style='width:250'> <input type='submit' value='上传' align=absmiddle><br>允许上传类型："&GetSaveDir(Request("Type"),2)&"<br>单个文件大小："&GetSaveDir(Request("Type"),3)&" KB</div>" & vbCrLf
  Response.write "<div id=downdiv style='display:none'><input name='FileUrl' type='text' class=input style='width:250'> <input type='submit' value='下载' align=absmiddle><br>允许下载类型：gif|jpg|bmp|png<br>单个文件大小："&GetSaveDir(Request("Type"),3)&" KB</div>" & vbCrLf
  Response.write "</form>" & vbCrLf
End If

Function GetSaveDir(uType,uSort)
  Select Case Int(uType)
    Case 1
      u_SaveDir = WR_UpLoad(2)
	  u_SaveFilter = WR_UpLoad(3)
	  u_SaveMaxSize = WR_UpLoad(4)
    Case 2
      u_SaveDir = WR_UpLoad(5)
      u_SaveFilter = WR_UpLoad(6)
      u_SaveMaxSize = WR_UpLoad(7)
    Case 3
      u_SaveDir = WR_UpLoad(8)
	  u_SaveFilter = WR_UpLoad(9)
	  u_SaveMaxSize = WR_UpLoad(10)
    Case 4
      u_SaveDir = WR_UpLoad(11)
	  u_SaveFilter = WR_UpLoad(12)
	  u_SaveMaxSize = WR_UpLoad(13)
    Case 5
      u_SaveDir = WR_UpLoad(14)
	  u_SaveFilter = WR_UpLoad(15)
	  u_SaveMaxSize = WR_UpLoad(16)
    Case 6
      u_SaveDir = WR_UpLoad(17)
	  u_SaveFilter = WR_UpLoad(18)
	  u_SaveMaxSize = WR_UpLoad(19)
    Case 7
      u_SaveDir = WR_UpLoad(38)
	  u_SaveFilter = WR_UpLoad(39)
	  u_SaveMaxSize = WR_UpLoad(40)
    Case 8
      u_SaveDir = WR_UpLoad(48)
	  u_SaveFilter = WR_UpLoad(49)
	  u_SaveMaxSize = WR_UpLoad(50)
    Case 9
      u_SaveDir = WR_UpLoad(51)
	  u_SaveFilter = WR_UpLoad(52)
	  u_SaveMaxSize = WR_UpLoad(53)
  End Select
  Select Case Int(uSort)
    Case 1
	  GetSaveDir = u_SaveDir
    Case 2
	  GetSaveDir = Lcase(u_SaveFilter)
    Case 3
	  GetSaveDir = Int(u_SaveMaxSize)
  End Select
End Function

Function GetFileName(uUrl,uFilter)
  UpErr = 0
  RemoteErr = 0
  u_Filter = Lcase(Split(uUrl,".")(UBound(Split(uUrl,"."))))
  u_Filter = Left(u_Filter,3)
  uFilter = Split(Lcase(uFilter),"|")
  For uI=0 To UBound(uFilter)
    If uFilter(uI) <> "" Then
	  If uFilter(uI) = u_Filter Then UpErr = 1
	End If
  Next
  u_uFilter = "gif|jpg|bmp|png"
  u_uFilter = Split(Lcase(u_uFilter),"|")
  For uI=0 To UBound(u_uFilter)
    If u_uFilter(uI) <> "" Then
	  If u_uFilter(uI) = u_Filter Then RemoteErr = 1
	End If
  Next
  If UpErr = 0 OR RemoteErr = 0 Then Response.Write "服务器不接受该类文档<br><a href=# Onclick=""javascript:history.back()"">返回</a>":Response.end
  Randomize Timer
  uFileNo = left(int(rnd*9998)+1000,4)
  GetFileName = Replace(Replace(Replace(Replace(Now(),"-",""),":","")," ",""),"/","")&uFileNo&"."&u_Filter
End Function

'生成缩略图及水印选项
Public Function IsObjInstalled(strClassString)
		On Error Resume Next
		IsObjInstalled = False
		Err = 0
		Dim xTestObj:Set xTestObj = Server.CreateObject(strClassString)
		If 0 = Err Then IsObjInstalled = True
		Set xTestObj = Nothing
		Err = 0
End Function
Public Function IsExpired(strClassString)
		On Error Resume Next
		IsExpired = True
		Err = 0
		Dim xTestObj:Set xTestObj = Server.CreateObject(strClassString)
	
		If 0 = Err Then
			Select Case strClassString
				Case "Persits.Jpeg"
					If xTestObj.Expires > Now Then
						IsExpired = False
					End If
				Case "wsImage.Resize"
					If InStr(xTestObj.errorinfo, "已经过期") = 0 Then
						IsExpired = False
					End If
				Case "SoftArtisans.ImageGen"
					xTestObj.CreateImage 500, 500, RGB(255, 255, 255)
12 下一页
⌨️ 快捷键说明

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