📄 admin_collection.asp

📁 个人网站比较简短
💻 ASP
📖 第 1 页 / 共 5 页
字号:
12 3 4 5 下一页
<!--#include file="Admin_Common.asp"-->
<!--#include file="Admin_CommonCode_Collection.asp"-->
<!--#include file="../Include/PowerEasy.FSO.asp"-->
<!--#include file="../Include/PowerEasy.XmlHttp.asp"-->
<!--#include file="../Include/PowerEasy.CreateThumb.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"   '其他权限

Private rs, sql, rsItem, i '通用变量
'项目公用变量
Private ItemID, ItemName, ClassID, SpecialID, ItemNum, ListNum, ItemEnd, ListEnd
Private Status, OnTop, Elite, Hot, Hits, Stars, InfoPoint, MaxCharPerPage, ShowCommentLink
Private FilterProperty, Script_Iframe, Script_Object, Script_Script, Script_Class, Script_Div, Script_Span, Script_Img, Script_Font, Script_A, Script_Html, Script_Table, Script_Tr, Script_Td
Private SaveFiles, SaveFlashUrlToFile, CollecOrder, CreateImmediate
Private ListStr, LsString, LoString, ListPaingType, LPsString, LPoString, ListPaingStr1, ListPaingStr2, ListPaingID1, ListPaingID2, ListPaingStr3, HsString, HoString, HttpUrlType, HttpUrlStr
Private TsString, ToString, CsString, CoString, AuthorType, AsString, AoString, AuthorStr, CopyFromType, FsString, FoString
Private CopyFromStr, KeyType, KsString, KoString, KeyStr, KeyScatterNum, NewsPaingType, NPsString, NPoString, NewsPaingStr1, NewsPaingStr2
Private PsString, PoString, PhsString, PhoString
Private IsString, IoString, IntroType, IntroStr, IntroNum, Intro
Private DateType, DsString, DoString
Private IncludePicYn, DefaultPicYn, PaginationType
'自定义字段采集变量
Private IsField, Field, iField
Private arrField, arrField2, FieldID, FieldName, FieldType, FisSting, FioSting, FieldStr
'登录验证变量
Private LoginType, LoginUrl, LoginPostUrl, LoginUser, LoginPass, LoginFalse
'采集选项变量
Private CollecTest, Content_view, IsTitle, IsLink
'采集相关的变量
Private CollecNewsi, CollecNewsj, CollectionModify, ItemIDStr
Private ItemIDArray, ContentTemp, NewsPaingNextCode, NewsPaingNext
Private Arr_j, Arr_i, NewsUrl, NewsCode
Private LoginData, LoginResult, CollecNewsA, OrderTemp, StartTime
'图片类型及保存路径
Private FilesOverStr, FilesPath, FilesArray, ImagesNum
'文章保存变量
Private ArticleID, Title, Content, Author, CopyFrom, Key, UpDateType, UpdateTime, IncludePic, UploadFiles, DefaultPicUrl
'历史记录
Private His_Title, His_NewsCollecDate, His_Result, His_Repeat, His_i
'采集列表处理变量
Private WebUrl, ListUrl, ListCode, ListUrlArray, NewsArrayCode, NewsArray, ListArray, ListPaingNext
Private tempStr, ItemIDtemp, TimeNum, rnd_temp, ArticleList, CollectionNum, CollectionType
Private AddWatermark, AddThumb, ItemSucceedNum, ItemSucceedNum2, ImagesNumAll, PaingNum, dirMonth, dtNow
Private Arr_Item, Arr_Histrolys, CollecType, Arr_Filters, Filteri, FilterStr, SwfTime, CollectionCreateHTML '采集缓存
'采集正文分页变量
Private PageListCode, PageArrayCode, PageArray
'定时生成
Private Timing_AreaCollection, TimingCreate
'收费文章属性
Private InfoPurview, arrGroupID, PitchTime, ReadTimes, DividePercent
'列表缩略图
Private ThumbnailType, ThsString, ThoString
Private ThumbnailArrayCode, ThumbnailArray, ThumbnailUrl
'转换路径
Private ConversionTrails


'采集定时刷新会包含变量http://
If InStr(ComeUrl, "?") > 0 Then
    ComeUrl = Left(ComeUrl, InStr(ComeUrl, "?"))
End If

    
'获得当前时间当前年月
dtNow = Now()
dirMonth = Year(dtNow) & Right("0" & Month(dtNow), 2)


XmlDoc.Load (Server.MapPath(InstallDir & "Language/Gb2312.xml"))



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

'这些代码暂时放到采集以后会移开
If Action = "CreateItemHtml" Then
Else
    Response.Write "<table width=""100%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""0"" class=""border"">" & vbCrLf
    Call ShowPageTitle("采 集 系 统 项 目 管 理", 10051)
    Response.Write "</table>" & vbCrLf
End If

Select Case Action
Case "Start"                    '开始采集
    Call Start
Case "main"                     '采集管理
    Call main
Case "CheckItem"
    Call CheckItem              '批量检测项目
Case "StopCollection"           '停止采集处理
    ItemEnd = True
    CollecNewsi = PE_CLng(Trim(Request("CollecNewsi")))         'CollecNewsi    显示采集成功数
    CollecNewsj = PE_CLng(Trim(Request("CollecNewsj")))         'CollecNewsj    显示采集失败数
    ArticleList = CStr(Trim(Request("ArticleList")))            'ArticleList 用于缓存不同的列表
    ItemSucceedNum2 = PE_CLng(Trim(Request("ItemSucceedNum2"))) 'ItemSucceedNum2 成功采集项目数
    ImagesNumAll = PE_CLng(Trim(Request("ImagesNumAll")))       'ImagesNumAll    项目总数
    CollecType = PE_CLng(Trim(Request("CollecType")))           'CollecType    采集模式 0 稳定 1 快速
    CollectionCreateHTML = Trim(Request("CollectionCreateHTML")) 'CollectionCreateHTML    生成html数组
    CreateImmediate = Trim(Request("CreateImmediate"))          'CreateImmediate 采集项目是否生成
    UseCreateHTML = PE_CLng(Trim(Request("UseCreateHTML")))     'UseCreateHTML   频道是否生成

    If CollectionCreateHTML = "" Then
        If CreateImmediate = "True" And UseCreateHTML <> 0 And ItemSucceedNum2 <> 0 Then
            CollectionCreateHTML = PE_CLng(Trim(Request("ChannelID"))) & "$" & PE_CLng(Trim(Request("ClassID"))) & "$" & ReplaceBadChar(Trim(Request("SpecialID"))) & "$" & ItemSucceedNum2
        End If
    Else '如果是多项目网站停止

        If CreateImmediate = "True" And UseCreateHTML <> 0 And ItemSucceedNum2 <> 0 Then
            CollectionCreateHTML = CollectionCreateHTML & "|" & PE_CLng(Trim(Request("ChannelID"))) & "$" & PE_CLng(Trim(Request("ClassID"))) & "$" & ReplaceBadChar(Trim(Request("SpecialID"))) & "$" & ItemSucceedNum2
        End If
    End If

    ErrMsg = "<br>已经停止当前项目,目前已完成！"
    ErrMsg = ErrMsg & "<li>成功采集： <font color=red>" & CollecNewsi & "</font>  篇,失败：<font color=blue> " & CollecNewsj & "</font>  篇,图片：<font color=green>" & ImagesNumAll & "</font> 个。</li>"
    Call PE_Cache.DelAllCache
    Call WriteSuccessMsg2(ErrMsg)
Case "CreateItemHtml"
    Call CreateItemHtml         '采集后自动生成Html
Case Else
    Call main
End Select
Response.Write "</body></html>"
Call CloseConn


'=================================================
'过程名：Main
'作  用：文章采集
'=================================================
Sub main()

    Dim sql, rs, SqlH, RsH, Flag, Action
    Dim iChannelID, ClassID, SpecialID, ItemID, ItemName, ListUrl, WebName, NewsCollecDate
    Dim SkinID, LayoutID, SkinCount, LayoutCount, MaxPerPage
        
    If Request("page") <> "" Then
        CurrentPage = CInt(Request("page"))
    Else
        CurrentPage = 1
    End If
    iChannelID = PE_CLng(Trim(Request("iChannelID")))
    MaxPerPage = PE_CLng(Trim(Request("MaxPerPage")))
    If MaxPerPage <= 0 Then MaxPerPage = 10
    
    strFileName = "Admin_Collection.asp?Action=Main&iChannelID=" & iChannelID

    Response.Write "<a name='submit'></a>" & vbCrLf
    Response.Write "<table width=""100%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""1"" class=""border"">" & vbCrLf
    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_Collection.asp?Action=Main>管理首页</a> | <a href=""Admin_CollectionManage.asp?Action=Step1"">添加新项目</a></td>" & vbCrLf
    Response.Write "  </tr>" & vbCrLf
    Response.Write "</table>"
    
    Response.Write "<SCRIPT language=javascript>" & vbCrLf
    Response.Write "    function CheckAll(thisform){" & vbCrLf
    Response.Write "        for (var i=0;i<thisform.elements.length;i++){" & vbCrLf
    Response.Write "            var e = thisform.elements[i];" & vbCrLf
    Response.Write "            if (e.Name != ""chkAll""&&e.disabled!=true&&e.zzz!=1)" & vbCrLf
    Response.Write "                e.checked = thisform.chkAll.checked;" & vbCrLf
    Response.Write "        }" & vbCrLf
    Response.Write "    }" & vbCrLf
    Response.Write "    function mysub(){" & vbCrLf
    Response.Write "        window.location='#submit';" & vbCrLf
    Response.Write "        esave.style.visibility=""visible"";" & vbCrLf
    Response.Write "    }" & vbCrLf
    Response.Write "</script>" & vbCrLf
    Response.Write "<br>" & vbCrLf
    
    If IsObjInstalled("MSXML2.XMLHTTP") = False Then
        Call WriteErrMsg("<li>您的系统没有安装XMLHTTP 组件,请到微软网站下载MSXML 4.0", ComeUrl)
        Exit Sub
    End If

    Response.Write "<table width='100%' border='0' align='center' cellpadding='2' cellspacing='1' class='border'>"
    Response.Write "<tr class='title'><td colspan='2'> | "
    sql = "SELECT DISTINCT I.ChannelID, C.ChannelName,C.ModuleType FROM PE_Item I LEFT OUTER JOIN PE_Channel C ON I.ChannelID = C.ChannelID"
    sql = sql & " WHERE C.ModuleType=1"
    Set rs = Conn.Execute(sql)
    If rs.BOF And rs.EOF Then
    Else
        Do While Not rs.EOF
            Response.Write "<a href='Admin_Collection.asp?Action=Main&iChannelID=" & rs("ChannelID") & "'><FONT style='font-size:12px'"
            If rs("ChannelID") = iChannelID Then Response.Write "color='red'"
            Response.Write ">" & rs("ChannelName") & "</FONT></a> | "
            rs.MoveNext
        Loop
        Response.Write "<a href='Admin_Collection.asp?Action=Main&iChannelID=0'><FONT style='font-size:12px'"
        If iChannelID = 0 Then Response.Write "color='red'"
        Response.Write "> 所有频道 </FONT></a> | "
    End If
    Response.Write "</td></tr>"
    Response.Write "</table>"
    rs.Close
    Set rs = Nothing
    Response.Write "<br>"
    Response.Write GetManagePath(iChannelID)
    Response.Write "<br>"
    Response.Write "<table class=""border"" border=""0"" cellspacing=""1"" width=""100%"" cellpadding=""0"">" & vbCrLf
    Response.Write "<form name=""myform"" method=""POST"" action=""Admin_Collection.asp"">" & vbCrLf
    Response.Write "  <tr class=""title"" style=""padding: 0px 2px;"">" & vbCrLf
    Response.Write "    <td width=""40"" height=""22"" align=""center""><strong>选择</strong></td>        " & vbCrLf
    Response.Write "    <td width=""100"" align=""center""><strong>项目名称</strong></td>" & vbCrLf
    Response.Write "    <td width=""100"" align=""center""><strong>采集地址</strong></td>" & vbCrLf
    Response.Write "    <td width=""100"" height=""22"" align=""center""><strong>所属频道</strong></td> " & vbCrLf
    Response.Write "    <td width=""100"" height=""22"" align=""center""><strong>所属栏目</strong></td> " & vbCrLf
12 3 4 5 下一页
💿 文件大小 7095 K
👤 上传用户 foreverlovely
📂 所属分类家庭/个人应用
🏷️ 相关标签

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

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