📄 wm.sys_cook.asp

📁 网人分类信息5.0商业版。非常优秀的分类信息系统。比较少见。
💻 ASP
📖 第 1 页 / 共 2 页
字号:
12 下一页
<!--#include file="../inc/Conn.asp"-->
<!--#include file="../Inc/Cls.Common.asp"-->
<!--#include file="../Inc/Cls.Templates.asp"-->
<!--#include file="../Inc/Cls.Content.asp"-->
<!--#include file="../Inc/Cls.Create.asp"-->
<%
   Dim cForm,zRs,AdminFlag,AdminFlagGroup
   Dim DB1,DB2,DB3,DB4,DB5,DB6,DB7,DB8,DB9,DB10,DB1T,DB2T,DB3T,DB4T,DB5T,DB6T,DB7T,DB8T,DB9T,DB10T
   
   If EnableSiteManageCode And Request.Cookies("Admin")("ManageCode") <> SiteManageCode Then Call WRMPS.ErrView("·请勿非法操作<meta http-equiv=refresh content='1;URL=Admin_login.asp'>", 0)
   If IsEmpty(Request.Cookies("Admin")("Admin")) Then
       Response.Write "<script language=JavaScript>" & vbCrLf
       Response.Write "window.open('Admin_login.asp','_parent');" & vbCrLf
       Response.Write "</script>" & vbCrLf
       Response.End()
   Else
       If IsEmpty(WRMPS.GetCookies("Attestation")) Then
	      Call DBConnBegin()
		  Set Rs = Conn.Execute("Select WM_UserName From WM_Admin Where WM_UserName = '"&Request.Cookies("Admin")("Admin")&"' and WM_PassWord='"&Request.Cookies("Admin")("Pass")&"'")
		  If Rs.Eof Then
		    Rs.Close
			Call WRMPS.ErrView("·请勿非法操作<meta http-equiv=refresh content='1;URL=Admin_login.asp'>", 0)
		  Else
			WRMPS.SCookies "Attestation","True",0
		  End If
		  Rs.Close
		  Set Rs = Nothing
	   End If
   End If
   
   AdminFlag = Request.Cookies("Admin")("Flag")
   AdminFlagGroup = Request.Cookies("Admin")("FlagGroup")
   Function CheckAdminFlag(byval Str)
     CheckAdminFlag = False
	 Select Case Int(AdminFlagGroup)
	   Case 0
	     CheckAdminFlag = True
	   Case 1
	     If Str <> "" Then If Instr(Ucase(","&AdminFlag&","),","&Ucase(Str)&",") > 0 Then CheckAdminFlag = True
	 End Select
   End Function

   With Response
    .write "<html><hand>"&vbCrLf
    .write "<meta HTTP-EQUIV=""Content-Type"" CONTENT=""text/html;charset=gb2312"">"&vbCrLf
    .write "<meta HTTP-EQUIV=""Content-Language"" CONTENT=""gb2312"">"&vbCrLf
    .write "<script language='JavaScript' src='img/Admin.Js'></script>"&vbCrLf
    .write "<link href=""img/Style.css"" rel=""stylesheet"" type=""text/css"">"&vbCrLf
   End With

   '=====================================
   '广告类型
   '=====================================
   Dim AdsType(10)
   AdsType(0) = "文字"
   AdsType(1) = "图片"
   AdsType(2) = "弹窗"
   AdsType(3) = "对联左"
   AdsType(4) = "对联右"
   AdsType(5) = "漂浮"
   AdsType(6) = "背投"
   AdsType(7) = "跟屏左"
   AdsType(8) = "跟屏右"
   AdsType(9) = "代码"
   AdsType(10) = "幻灯广告"

   '=====================================
   '通用分页 GetAdminPageList
   'URLParameter 控制参数
   'PageValue:每页显示记录数
   'RetCount:总记录数
   'CurrentPage:当前页数
   '=====================================
   Function GetAdminPageList(URLParameter,PageValue,retCount,CurrentPage)
    Dim PageContent,PageName,URLP
    PageValue=Int(PageValue)
	If RetCount="" Then RetCount = 0
    RetCount=Int(RetCount)
	If CurrentPage="" Then CurrentPage=0
    CurrentPage=Int(CurrentPage)
	If RetCount > 0 Then
      If (RetCount Mod PageValue) = 0 Then
	     PagesCount = RetCount \ PageValue
	  Else
	     PagesCount = (RetCount \ PageValue)+1
	  End If
      PageName = Request.ServerVariables("url")
	  If URLParameter <> "" Then URLParameter = "&"&URLParameter
	  PageContent = PageContent & "<strong>[</strong><font color=red><strong>" & RetCount & "</strong></font>/<font color=red><strong>" & CurrentPage & "</strong></font>/<font color=red><strong>" & PagesCount & "</strong></font><strong>]</strong>" & vbCrLf
	    If CurrentPage > 1 Then
	      PageContent = PageContent & "<a href='"&PageName&"?Page=1" & URLParameter & "'><font face='webdings'>9</font></a>"
	      PageContent = PageContent & " <a href='"&PageName&"?Page=" & CurrentPage-1 & URLParameter & "'><font face='webdings'>7</font></a>"
	      PageContent = PageContent & " <a href='"&PageName&"?Page=" & CurrentPage-1 & URLParameter & "'><b>[" & CurrentPage-1 & "]</b></a>" & vbCrLf
	    End If
	    If PagesCount <> 1 Then
		  PageContent = PageContent & "<b>[" & CurrentPage & "]</b>" & vbCrLf
	    End If
        If PagesCount-CurrentPage <> 0 Then
		  PageContent = PageContent & "<a href='"&PageName&"?Page=" & CurrentPage+1 & URLParameter & "'><b>[" & CurrentPage+1 & "]</b></a>"
		  PageContent = PageContent & " <a href='"&PageName&"?Page=" & CurrentPage+1 & URLParameter & "'><font face='webdings'>8</font></a>"
		  PageContent = PageContent & " <a href='"&PageName&"?Page=" & PagesCount & URLParameter & "'><font face='webdings'>:</font></a>" & vbCrLf
	    End If
	  PageContent = PageContent & "<select name=PageGo onChange=""javascript:if(this.options[this.selectedIndex].value) window.open(this.options[this.selectedIndex].value,'_self')"">" & vbCrLf
      Dim d
	  For d=1 to PagesCount
	  PageContent = PageContent & "<option value="&PageName&"?Page=" & d & URLParameter &WRMPS.GetCheckVer(d,page,0)&">"&d&"</option>" & vbCrLf
	  Next
      PageContent = PageContent & "</select>" & vbCrLf
	End If
	GetAdminPageList = PageContent
   End Function
   
   Sub GetBottom()
     Response.Write "<table width='100%' border=0 cellspacing=0 cellpadding=5 style='border-top:1px #C4D8ED solid'><tr><td align=center class=td2>" & vbCrLf
     Response.Write "Copyright &copy; 2004-2009 <a href=http://www.wangren.net target=_blank><font face=Verdana, Arial, Helvetica, sans-serif><b><font color=#990000>WangRen</font><font color=blue>.Net</font></b></font></a> Inc. All rights reserved."
     Response.Write "</td></tr></table>" & vbCrLf
   End Sub
   
   'zType：分类1自订义标签2系统标签...
   'zDefault：默认ID
   'zFormName：表单名
   'zonChange：鼠标事件
   Function GetLabelSort(zType,zDefault,zFormName,zonChange,zList)
      Dim zRs,zI,SortList
      If zType = "" Then Exit Function
	  If zDefault = "" Then zDefault = 0
	  If zonChange <> "" Then zonChange = " onChange='"&zonChange&"'"
      GetLabelSort = "<select name='"&zFormName&"'"&zonChange&">" & vbCrLf
      GetLabelSort = GetLabelSort & "<option value='未分类'>未分类</option>" & vbCrLf
	  If zList > 0 Then
	    If zDefault = "未分类" Or IsNUll(zDefault) Then SortList = SortList & "<strong>"
        SortList = SortList & "<a href=?"&zFormName&"=未分类&Type="&zType&">未分类</a>" & vbCrLf
	    If zDefault = "未分类" Or IsNUll(zDefault) Then SortList = SortList & "</strong>"
	  End If
	  Set zRs = Conn.Execute("Select WM_ID,WM_Depth,WM_Child,WM_Name From WM_LabelSort Where WM_Type="&zType&" and WM_SkinDir = '"&WR_Setting(5)&"' Order By WM_ClassID,WM_Taxis")
      If zRs.EOF Then
        GetLabelSort = GetLabelSort & "<option value=''>请先添加分类</option>"
      Else
        Do While Not zRs.EOF
	    If zList > 0 Then
		  If zDefault = zRs(3) Then SortList = SortList & "<strong>"
          SortList = SortList & "<a href=?"&zFormName&"=" & zRs(3) & "&Type="&zType&">" & zRs(3) & "</a>" & vbCrLf
		  If zDefault = zRs(3) Then SortList = SortList & "</strong>"
        End If
		GetLabelSort = GetLabelSort & "<option value='" & zRs(3) & "'"&WRMPS.GetCheckVer(zDefault,zRs(3),0)&">"
        If zRs(1) > 0 Then
          For zI = 1 To zRs(1)
            GetLabelSort = GetLabelSort & "　"
          Next
12 下一页
⌨️ 快捷键说明

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