📄 admin_areacollection.asp

📁 个人网站比较简短
💻 ASP
📖 第 1 页 / 共 4 页
字号:
12 3 4 下一页
<!--#include file="Admin_Common.asp"-->
<!--#include file="Admin_CommonCode_Collection.asp"-->
<!--#include file="../Include/PowerEasy.FSO.asp"-->
<!--#include file="../Include/PowerEasy.XmlHttp.asp"-->
<%
'**************************************************************
' Software name: PowerEasy SiteWeaver
' Web: http://www.powereasy.net
' Copyright (C) 2005－2008 佛山市动易网络科技有限公司 版权所有
'**************************************************************

Const NeedCheckComeUrl = True   '是否需要检查外部访问

Const PurviewLevel = 2      '0--不检查，1--超级管理员，2--普通管理员
Const PurviewLevel_Channel = 0   '0--不检查，1--频道管理员，2--栏目总编，3--栏目管理员
Const PurviewLevel_Others = "Collection"   '其他权限


Dim rs, sql, rsItem, rsFilters, rsHistory '通用变量

Response.Write "<html>" & vbCrLf
Response.Write "<head>" & vbCrLf
Response.Write "<title>区域采集管理</title>" & vbCrLf
Response.Write "<meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312"">" & vbCrLf
Response.Write "<link rel=""stylesheet"" type=""text/css"" href=""Admin_Style.css"">" & vbCrLf
Response.Write "</head>" & vbCrLf
Response.Write "<body leftmargin=""0"" topmargin=""0"" marginwidth=""0"" marginheight=""0"">" & vbCrLf

Response.Write "<table width=""100%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""1"" class=""border"">" & vbCrLf
Call ShowPageTitle(" 区 域 采 集 管 理 ", 10056)
If Trim(Request("Timing_AreaCollection")) = "" Then
    Response.Write "  <tr class=""tdbg""> " & vbCrLf
    Response.Write "    <td width=""70"" height=""30""><strong>管理导航：</strong></td>" & vbCrLf
    Response.Write "    <td height=""30""><a href=Admin_AreaCollection.asp?Action=AreaCollectionManage>管理首页</a> | <a href=""Admin_AreaCollection.asp?Action=AreaCollectionAdd"">添加区域采集项目</a></td>" & vbCrLf
    Response.Write "  </tr>" & vbCrLf
End If
Response.Write "</table>"

Select Case Action
    Case "AreaCollectionAdd"
        Call AreaCollectionAdd
    Case "AreaCollectionModify"
        Call AreaCollectionAdd
    Case "AreaCollectionManage"
        Call AreaCollectionManage
    Case "AreaCollectionSave"
        Call AreaCollectionSave
    Case "AreaCollectionDel"
        Call AreaCollectionDel
    Case "AreaCollectionPreviewFile"
        Call AreaCollectionPreviewFile
    Case "AreaCollectionCreateFile"
        Call AreaCollectionCreateFile
    Case Else
        Call AreaCollectionManage
End Select
If FoundErr = True Then
    Call WriteErrMsg(ErrMsg, ComeUrl)
End If

Response.Write "</body></html>"
Call CloseConn


'**************************************************
'方法名：AreaCollectionAdd
'作  用：添加采集数据
'**************************************************
Sub AreaCollectionAdd()
    Dim rsItem, sql
    Dim AreaID, AreaName, AreaFile, AreaIntro, Code, StringReplace, AreaUrl
    Dim LableStart, LableEnd, FilterProperty, UpFileType, AreaPassed
    Dim Script_Property

    FoundErr = False
 
    If Action = "AreaCollectionModify" Then
        AreaID = PE_CLng(Trim(Request("AreaID")))
        If IsNumeric(AreaID) = False Or AreaID = 0 Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>AreaID,参数错误！</li>"
        End If
        If FoundErr <> True Then
            '取出数据
            sql = "select * from PE_AreaCollection where AreaID=" & AreaID & " and Type=0"
            Set rsItem = Server.CreateObject("adodb.recordset")
            rsItem.Open sql, Conn, 1, 1
            If rsItem.EOF Then   '没有找到该项目
                FoundErr = True
                ErrMsg = ErrMsg & "<li>错误参数！没有找到该项目！</li>"
            Else
                AreaID = rsItem("AreaID")
                AreaName = rsItem("AreaName")
                AreaFile = rsItem("AreaFile")
                AreaIntro = rsItem("AreaIntro")
                Code = rsItem("Code")
                AreaUrl = rsItem("AreaUrl")
                StringReplace = rsItem("StringReplace")
                LableStart = rsItem("LableStart")
                LableEnd = rsItem("LableEnd")
                FilterProperty = rsItem("FilterProperty")
                UpFileType = rsItem("UpFileType")
                AreaPassed = rsItem("AreaPassed")
            End If
            rsItem.Close
            Set rsItem = Nothing
        End If
        If FoundErr = True Then
            Call WriteErrMsg(ErrMsg, ComeUrl)
            Exit Sub
        End If
    Else
        Code = 0
        FilterProperty = "0|0|0|0|0|0|0|0|0|0|0|0|0"
        UpFileType = "gif|jpg|jpeg|jpe|bmp|png|swf|mid|mp3|wmv|asf|avi|mpg|ram|rm|ra|rmvb|html|asp|shtml|jsp|shtml|htm|php|cgi"
    End If

    Response.Write "<script language=""JavaScript"">" & vbCrLf
    Response.Write "<!--" & vbCrLf
    Response.Write "function setFileFileds(num){    " & vbCrLf
    Response.Write "    for(var i=1,str="""";i<=9;i++){" & vbCrLf
    Response.Write "        eval(""objFiles"" + i +"".style.display='none';"")" & vbCrLf
    Response.Write "    }" & vbCrLf
    Response.Write "    for(var i=1,str="""";i<=num;i++){" & vbCrLf
    Response.Write "        eval(""objFiles"" + i +"".style.display='';"")" & vbCrLf
    Response.Write "    }" & vbCrLf
    Response.Write "}" & vbCrLf
    Response.Write "//-->" & vbCrLf
    Response.Write "</script>" & vbCrLf

    Response.Write "<br>" & vbCrLf
    Response.Write "<table class=border cellSpacing=1 cellPadding=0 width=""100%"" align=center border=0>" & vbCrLf
    Response.Write "<FORM name=form1 action='Admin_AreaCollection.asp' method=post>" & vbCrLf
    Response.Write "  <tr>" & vbCrLf
    Response.Write "    <td class=title colSpan=2 height=22>" & vbCrLf
    Response.Write "      <DIV align=center><STRONG>"
    If Action = "AreaCollectionModify" Then
        Response.Write " 修 改 区 域 采 集 项 目 "
    Else
        Response.Write " 添 加 区 域 采 集 项 目 "
    End If
    Response.Write "</STRONG></DIV></td>" & vbCrLf
    Response.Write "  </tr>" & vbCrLf
    Response.Write "  <tr class=""tdbg""> " & vbCrLf
    Response.Write "    <td width=""150"" class=""tdbg"" align=""right""><strong> 采集区域项目名称：&nbsp;</strong></td>" & vbCrLf
    Response.Write "    <td class=""tdbg""><input name=""AreaName"" type=""text"" id=""AreaName"" size=""20"" maxlength=""20"" value=" & AreaName & "> <font color=red> * </font></td>" & vbCrLf
    Response.Write "  </tr>" & vbCrLf
    Response.Write "  <tr class=""tdbg""> " & vbCrLf
    Response.Write "    <td width=""150"" class=""tdbg"" align=""right""><strong> 采集区域项目简介：&nbsp;</strong></td>" & vbCrLf
    Response.Write "    <td class=""tdbg""> <TEXTAREA NAME='AreaIntro' ROWS='' COLS='' style='width:300px;height:70px'>" & Server.HTMLEncode(AreaIntro) & "</TEXTAREA><font color=red> * </font></td>" & vbCrLf
    Response.Write "  </tr>" & vbCrLf
    Response.Write "  <tr class=""tdbg""> " & vbCrLf
    Response.Write "    <td width=""150"" class=""tdbg"" align=""right""><strong> 文件名称：&nbsp;</strong> </td>" & vbCrLf
    Response.Write "    <td class=""tdbg""><input name=""AreaFile"" type=""text"" id=""AreaFile"" size=""30"" maxlength=""30"" value=" & AreaFile & "> <font color=red> * </font><FONT color='blue'>例如: xxxx.html</FONT></td>" & vbCrLf
    Response.Write "  </tr>" & vbCrLf
    Response.Write "  <tr class='tdbg2'> " & vbCrLf
    Response.Write "    <td height='25' align=""center"" colspan='2' ><strong> 参数设置</strong></td>" & vbCrLf
    Response.Write "  </tr>" & vbCrLf
    Response.Write "  <tr class=""tdbg""> " & vbCrLf
    Response.Write "    <td width=""150"" class=""tdbg"" align=""right""><strong> 网站URL：&nbsp;</strong></td>" & vbCrLf
    Response.Write "    <td class=""tdbg""><input name=""AreaUrl"" type=""text"" id=""AreaUrl"" size=""50"" maxlength=""50"" value=" & AreaUrl & "> <font color=red> * </font></td>" & vbCrLf
    Response.Write "  </tr>" & vbCrLf
    Response.Write "  <tr class=""tdbg""> " & vbCrLf
    Response.Write "    <td width=""150"" class=""tdbg"" align=""right""><strong> 网页编码格式：&nbsp;</strong></td>" & vbCrLf
    Response.Write "    <td class=""tdbg"">GB2312：<INPUT TYPE='radio' NAME='Code' value='0' "
    If PE_CLng(Code) = 0 Then Response.Write "checked"
    Response.Write "> UTF-8：<INPUT TYPE='radio' NAME='Code' value='1' "
    If PE_CLng(Code) = 1 Then Response.Write "checked"
    Response.Write "> Big5：<INPUT TYPE='radio' NAME='Code' value='2' "
    If PE_CLng(Code) = 2 Then Response.Write "checked"
    Response.Write "><font color=red> * </font>" & vbCrLf
    Response.Write "     &nbsp;</td>" & vbCrLf
    Response.Write "  </tr>" & vbCrLf
    Response.Write "  <tr class=""tdbg""> " & vbCrLf
    Response.Write "    <td width=""150"" class=""tdbg"" align=""right""><strong> 截取开始字符：&nbsp;</strong></td>" & vbCrLf
    Response.Write "    <td class=""tdbg""> <TEXTAREA NAME='LableStart' ROWS='' COLS='' style='width:400px;height:70px'>" & Server.HTMLEncode(LableStart) & "</TEXTAREA><font color=red> * </font></td>" & vbCrLf
    Response.Write "  </tr>" & vbCrLf
    Response.Write "  <tr class=""tdbg""> " & vbCrLf
    Response.Write "    <td width=""150"" class=""tdbg"" align=""right""><strong> 截取结束字符：&nbsp;</strong></td>" & vbCrLf
    Response.Write "    <td class=""tdbg""> <TEXTAREA NAME='LableEnd' ROWS='' COLS='' style='width:400px;height:70px'>" & Server.HTMLEncode(LableEnd) & "</TEXTAREA><font color=red> * </font></td>" & vbCrLf
    Response.Write "  </tr>" & vbCrLf

    Dim arrAreaCode2, arrAreaCode, AreaCode1, AreaCode2, i, ReplaceNum
    arrAreaCode2 = Split(StringReplace, "$$$")
    ReplaceNum = UBound(arrAreaCode2) + 1

    If Action = "AreaCollectionModify" Then
        Response.Write "  <tr class=""tdbg""> " & vbCrLf
        Response.Write "    <td width=""150"" class=""tdbg"" align=""right""><strong> 截取代码预览：&nbsp;</strong></td>" & vbCrLf
        Response.Write "    <td class=""tdbg""> <TEXTAREA NAME='preview' ROWS='' COLS='' style='width:500px;height:100px'>" & Server.HTMLEncode(GetBody(GetHttpPage(AreaUrl, PE_CLng(Code)), LableStart, LableEnd, True, True)) & "</TEXTAREA><font color=red> * </font></td>" & vbCrLf
        Response.Write "  </tr>" & vbCrLf
    End If

    Response.Write "  <tr class=""tdbg""> " & vbCrLf
    Response.Write "    <td width=""150"" class=""tdbg"" align=""right""><strong> 字符替换项目数：&nbsp;</strong></td>"
    Response.Write "    <td class=""tdbg"">" & vbCrLf
    Response.Write "      <select name=""ReplaceNum"" onChange=""setFileFileds(this.value)"">" & vbCrLf
    Response.Write "         <option value=""0"" " & IsOptionSelected(ReplaceNum, 0) & ">0</option>" & vbCrLf
    Response.Write "         <option value=""1"" " & IsOptionSelected(ReplaceNum, 1) & ">1</option>" & vbCrLf
    Response.Write "         <option value=""2"" " & IsOptionSelected(ReplaceNum, 2) & ">2</option>" & vbCrLf
    Response.Write "         <option value=""3"" " & IsOptionSelected(ReplaceNum, 3) & ">3</option>" & vbCrLf
    Response.Write "         <option value=""4"" " & IsOptionSelected(ReplaceNum, 4) & ">4</option>" & vbCrLf
    Response.Write "         <option value=""5"" " & IsOptionSelected(ReplaceNum, 5) & ">5</option>" & vbCrLf
    Response.Write "         <option value=""6"" " & IsOptionSelected(ReplaceNum, 6) & ">6</option>" & vbCrLf
    Response.Write "         <option value=""7"" " & IsOptionSelected(ReplaceNum, 7) & ">7</option>" & vbCrLf
    Response.Write "         <option value=""8"" " & IsOptionSelected(ReplaceNum, 8) & ">8</option>" & vbCrLf
    Response.Write "         <option value=""9"" " & IsOptionSelected(ReplaceNum, 9) & ">9</option>" & vbCrLf
    Response.Write "      </select>" & vbCrLf
    Response.Write "    </td>" & vbCrLf
    Response.Write "  </tr>" & vbCrLf
    Response.Write "  <tr class=""tdbg""> " & vbCrLf
    Response.Write "    <td width=""150"" class=""tdbg"" align=""right""></td>" & vbCrLf
    Response.Write "    <td class=""tdbg"">" & vbCrLf
    Response.Write "      <table border='0' cellpadding='0' cellspacing='0' width='100%' height='100%' align='center'>" & vbCrLf
    If Action = "AreaCollectionAdd" Then
        For i = 1 To 9
            Response.Write "  <tr class=""tdbg"" onmouseout=""this.className='tdbg'"" onmouseover=""this.className='tdbgmouseover'"">" & vbCrLf
            Response.Write "    <td class=""tdbg""  id=""objFiles" & i & """ valign='top' style=""display:'none'"">" & vbCrLf
            Response.Write i
            Response.Write "        将字符：<TEXTAREA NAME='ReplaceQuilt" & i & "' ROWS='' COLS='' style='width:250px;height:50px'></TEXTAREA>"
            Response.Write "        替换为：<TEXTAREA NAME='ReplaceWith" & i & "' ROWS='' COLS='' style='width:250px;height:50px'></TEXTAREA>"
            Response.Write "    </td>" & vbCrLf
            Response.Write "  </tr>" & vbCrLf
        Next
    Else
        For i = 0 To UBound(arrAreaCode2)
            arrAreaCode = Split(arrAreaCode2(i), "|||")
            AreaCode1 = arrAreaCode(0)
            AreaCode2 = arrAreaCode(1)

            Response.Write "  <tr class=""tdbg"" onmouseout=""this.className='tdbg'"" onmouseover=""this.className='tdbgmouseover'"">" & vbCrLf
            Response.Write "    <td class=""tdbg""  id=""objFiles" & i + 1 & """ valign='top' style=""display:''"">" & vbCrLf
            Response.Write i + 1
            Response.Write "        将字符：<TEXTAREA NAME='ReplaceQuilt" & i + 1 & "' ROWS='' COLS='' style='width:250px;height:50px'>" & Server.HTMLEncode(AreaCode1) & "</TEXTAREA>"
            Response.Write "        替换为：<TEXTAREA NAME='ReplaceWith" & i + 1 & "' ROWS='' COLS='' style='width:250px;height:50px'>" & Server.HTMLEncode(AreaCode2) & "</TEXTAREA>"
            Response.Write "    </td>" & vbCrLf
            Response.Write "  </tr>" & vbCrLf
12 3 4 下一页
💿 文件大小 7095 K
👤 上传用户 foreverlovely
📂 所属分类家庭/个人应用
🏷️ 相关标签

#网站 #比较
⌨️ 快捷键说明

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