📄 admin_articlegather.asp
字号:
.Write Rs("lastime")
End If
.Write "</td>"
.Write " <td " & stylestr & "><a href='?action=edit&ItemID=" & Rs("ItemID") & "&ChannelID=" & ChannelID & "'>编辑</a> | "
.Write "<a href='?action=begin&ItemID=" & Rs("ItemID") & "&ChannelID=" & ChannelID & "'>采集</a> | "
.Write "<a href='?action=demo&ItemID=" & Rs("ItemID") & "&ChannelID=" & ChannelID & "'>演示</a> | "
.Write "<a href='?action=copy&ItemID=" & Rs("ItemID") & "&ChannelID=" & ChannelID & "'>克隆</a> | "
.Write "<a href='?action=del&ItemID=" & Rs("ItemID") & "&ChannelID=" & ChannelID & "' onclick=""{if(confirm('您确定要删除此项目吗?')){return true;}return false;}"">删除</a>"
.Write "</td>"
.Write "</tr>"
Rs.MoveNext
i = i + 1
If i >= maxperpage Then Exit Do
Loop
End If
Rs.Close
Set Rs = Nothing
.Write "<tr>"
.Write " <td colspan=""9"" class=""tablerow2"" align=""right"">"
ShowListPage CurrentPage, Pcount, totalnumber, maxperpage, "&ChannelID=" & ChannelID & "", sModuleName & "采集"
.Write "</td>"
.Write "</tr>"
If LCase(Request("action")) = "yes" Then
.Write "<tr>"
.Write " <td colspan=9 class=tablerow2>"
.Write "<b class=style2>恭喜您！采集" & sModuleName & "全部完成..."
.Write "成功采集" & sModuleName & " <font color=""#FF0000"">" & Session("SucceedCount") & "</font> 个，总费时 <font color=""#FF0000"">" & FormatNumber((Timer() - Request("D")), 2, -1) & "</font> 秒,完成时间" & Now() & "</b>"
.Write "</td>"
.Write "</tr>"
Session("SucceedCount") = 0
End If
.Write "</table>"
End With
End Sub
'=================================================
'函数名：Read_Class_Name
'作 用：读取分类名称
'=================================================
Private Function Read_Class_Name(ByVal ClassID)
Dim rsClass
On Error Resume Next
Set rsClass = Newasp.Execute("SELECT ClassName FROM NC_Classify WHERE ClassID=" & ClassID)
If rsClass.BOF And rsClass.EOF Then
Read_Class_Name = "没有分类"
Set rsClass = Nothing
Exit Function
End If
Read_Class_Name = rsClass(0)
Set rsClass = Nothing
End Function
'=================================================
'函数名：Read_Special_Name
'作 用：读取专题名称
'=================================================
Private Function Read_Special_Name(ByVal SpecialID)
Dim rsSpecial
On Error Resume Next
Set rsSpecial = Newasp.Execute("SELECT SpecialName FROM NC_Special WHERE SpecialID=" & SpecialID)
If rsSpecial.BOF And rsSpecial.EOF Then
Read_Special_Name = "没有指定专题"
Set rsSpecial = Nothing
Exit Function
End If
Read_Special_Name = rsSpecial(0)
Set rsSpecial = Nothing
End Function
'=================================================
'函数名：GetClassID
'作 用：读取分类ID
'=================================================
Public Function GetClassID(ByVal chanid, ByVal superior, ByVal inferior)
superior = Replace(Trim(superior), "'", "")
inferior = Replace(Trim(inferior), "'", "")
chanid = Mynewasp.ChkNumeric(chanid)
If superior = "" Or chanid = 0 Then
GetClassID = 0
Exit Function
End If
On Error Resume Next
Dim oRs, SQL, clsid, iRs
clsid = 0
SQL = "SELECT ClassID,ClassName,child FROM [NC_Classify] WHERE ChannelID=" & chanid & " And TurnLink=0 And ClassName='" & superior & "'"
Set oRs = Newasp.Execute(SQL)
If Not (oRs.BOF And oRs.EOF) Then
If oRs("child") = 0 Then
clsid = oRs("ClassID")
Else
If inferior <> "" Then
Set iRs = Newasp.Execute("SELECT ClassID,ClassName,child FROM [NC_Classify] WHERE ChannelID=" & chanid & " And parentid=" & oRs("classid") & " And child=0 And TurnLink=0 And ClassName='" & inferior & "'")
If Not (iRs.BOF And iRs.EOF) Then
clsid = iRs("ClassID")
End If
Set iRs = Nothing
End If
End If
Else
clsid = 0
End If
Set oRs = Nothing
GetClassID = clsid
End Function
Public Function ClassUpdateCount(ChannelID, sortid)
Dim rscount, Parentstr
On Error Resume Next
Set rscount = Newasp.Execute("SELECT ClassID,Parentstr FROM [NC_Classify] WHERE ChannelID = " & CLng(ChannelID) & " And ClassID=" & CLng(sortid))
If Not (rscount.BOF And rscount.EOF) Then
Parentstr = rscount("Parentstr") & "," & rscount("ClassID")
Newasp.Execute ("UPDATE [NC_Classify] SET ShowCount=ShowCount+1,isUpdate=1 WHERE ChannelID = " & CLng(ChannelID) & " And ClassID in (" & Parentstr & ")")
End If
Set rscount = Nothing
End Function
'--采集基本设置
Private Sub BasalConfig()
With Response
.Write "<form name=myform method=post action='?action=save'>" & vbCrLf
.Write "<input type=hidden name='ChannelID' value='" & ChannelID & "'>" & vbCrLf
.Write "<table border=""0"" align=""center"" cellpadding=""3"" cellspacing=""1"" class=""TableBorder""> " & vbCrLf
.Write " <tr> " & vbCrLf
.Write " <th colspan=""2"">" & sModuleName & "采集基本设置</th> " & vbCrLf
.Write " </tr> " & vbCrLf
.Write " <tr> " & vbCrLf
.Write " <td width=""23%"" align=""right"" nowrap class=""TableRow1""><strong>采集功能开关：</strong></td> " & vbCrLf
.Write " <td width=""77%"" class=""TableRow1""><input name=""stopGather"" type=""radio"" value=""1"""
If CInt(stopGather) = 1 Then .Write " checked"
.Write ">" & vbCrLf
.Write " 关闭 " & vbCrLf
.Write " <input type=""radio"" name=""stopGather"" value=""0"""
If CInt(stopGather) = 0 Then .Write " checked"
.Write ">" & vbCrLf
.Write " 打开 " & vbCrLf
.Write " <input type=""radio"" name=""stopGather"" value=""9"""
If CInt(stopGather) = 9 Then .Write " checked"
.Write ">" & vbCrLf
.Write " 采集测试<font color='red'>(供测试程序用，不写数据库)</font></td> " & vbCrLf
.Write " </tr> " & vbCrLf
.Write " <tr> " & vbCrLf
.Write " <td align=""right"" class=""TableRow2""><strong>重复" & sModuleName & "处理：</strong></td> " & vbCrLf
.Write " <td class=""TableRow2""><input name=""RepeatDeal"" type=""radio"" value=""0"""
If CInt(RepeatDeal) = 0 Then .Write " checked"
.Write ">" & vbCrLf
.Write " 跳过 " & vbCrLf
.Write " <input type=""radio"" name=""RepeatDeal"" value=""1"""
If CInt(RepeatDeal) > 0 Then .Write " checked"
.Write ">" & vbCrLf
.Write " 更新 </td> " & vbCrLf
.Write " </tr> " & vbCrLf
.Write " <tr> " & vbCrLf
.Write " <td align=""right"" class=""TableRow1""><strong>允许下载的图片大小：</strong></td> " & vbCrLf
.Write " <td class=""TableRow1""><input name=""MaxPicSize"" type=""text"" id=""MaxPicSize"" size=""12"" value=""" & MaxPicSize & """ maxlength=""10""> " & vbCrLf
.Write " <strong><font color=""blue"">KB </font></strong> <font color=""red"">* 不限制请输入“0”</font></td> " & vbCrLf
.Write " </tr> " & vbCrLf
.Write " <tr> " & vbCrLf
.Write " <td align=""right"" class=""TableRow2""><strong>允许下载的文件类型：</strong></td> " & vbCrLf
.Write " <td class=""TableRow2""><input name=""AllowPicExt"" type=""text"" id=""AllowPicExt"" size=""50"" value=""" & AllowPicExt & """ maxlength=""255""> " & vbCrLf
.Write " <font color=""blue"">* 每个文件类型请用“|”分开</font></td> " & vbCrLf
.Write " </tr> " & vbCrLf
.Write " <tr> " & vbCrLf
.Write " <td align=""right"" class=""TableRow1""><strong>采集过程间隔时间：</strong></td> " & vbCrLf
.Write " <td class=""TableRow1""> <input name=""setInterval"" type=""text"" id=""setInterval"" size=""12"" value=""" & setInterval & """ maxlength=""10""> " & vbCrLf
.Write " <font color=""blue"">毫秒 </font></td> " & vbCrLf
.Write " </tr> " & vbCrLf
.Write " <tr> " & vbCrLf
.Write " <td align=""right"" class=""TableRow2""> </td> " & vbCrLf
.Write " <td class=""TableRow2""><div align=""center""> " & vbCrLf
.Write " <input name=""B12"" type=""button"" class=""Button"" onclick=""javascript:history.go(-1)"" value=""返回上一页""> " & vbCrLf
.Write " " & vbCrLf
.Write "<input name=""B22"" type=""submit"" class=""Button"" value=""保存设置"">" & vbCrLf
.Write "</div></td> " & vbCrLf
.Write " </tr> " & vbCrLf
.Write "</table></form> " & vbCrLf
End With
End Sub
Private Sub SaveConfig()
If Len(Request.Form("AllowPicExt")) = 0 Then
OutErrors ("请输入允许下载的文件类型!")
Exit Sub
End If
Mynewasp.DelCahe ("NewsConfig")
Set Rs = CreateObject("ADODB.Recordset")
SQL = "SELECT * FROM NC_NewsConfig WHERE id=1"
Rs.Open SQL, MyConn, 1, 3
Rs("stopGather") = Mynewasp.ChkNumeric(Request.Form("stopGather"))
Rs("RepeatDeal") = Mynewasp.ChkNumeric(Request.Form("RepeatDeal"))
Rs("setInterval") = Mynewasp.ChkNumeric(Request.Form("setInterval"))
Rs("MaxPicSize") = Mynewasp.ChkNumeric(Request.Form("MaxPicSize"))
Rs("AllowPicExt") = Trim(Request.Form("AllowPicExt"))
Rs.Update
Rs.Close: Set Rs = Nothing
OutScript ("保存采集基本设置成功!")
End Sub
'--项目设置步骤
Private Sub SettingStep(ItemID)
With Response
.Write "<tr>" & vbNewLine
.Write " <td colspan=2 align=center class=tablerow2>"
.Write "<a href='?ChannelID=" & ChannelID & "' style=""color: green;"">管理首页</a> | "
.Write "<a href='?action=edit&ChannelID=" & ChannelID & "&ItemID=" & ItemID & "' class=showmenu>设置第一步</a> | "
.Write "<a href='?action=step2&ChannelID=" & ChannelID & "&ItemID=" & ItemID & "' class=showmenu>设置第二步</a> | "
.Write "<a href='?action=step3&ChannelID=" & ChannelID & "&ItemID=" & ItemID & "' class=showmenu>设置第三步</a> | "
.Write "<a href='?action=demo&ChannelID=" & ChannelID & "&ItemID=" & ItemID & "' class=showmenu>项目演示</a> | "
.Write "<a href='?action=begin&ChannelID=" & ChannelID & "&ItemID=" & ItemID & "' style=""color: red;"">开始采集</a>"
.Write "</td>" & vbNewLine
.Write "</tr>" & vbNewLine
End With
End Sub
'--编辑采集项目设置
Private Sub CollectionItem(isEdit)
Dim sClassSelect, RsObj, ItemTitle
Dim i, ArrayRetuneClass
Dim ArrayRemoveCode
If isEdit Then
Set Rs = MyConn.Execute("SELECT * FROM NC_NewsItem WHERE ChannelID=" & ChannelID & " And ItemID=" & ItemID)
If Rs.BOF And Rs.EOF Then
Set Rs = Nothing
OutErrors ("错误的系统参数!")
Exit Sub
End If
ItemTitle = "编辑采集项目 第一步"
Else
ItemID = 0
ItemTitle = "添加新的采集项目"
End If
With Response
.Write "<script language=""javascript"" src=""include/Gatherer.js""></script>" & vbCrLf
.Write "<form name=myform method=post action=""" & ScriptName & """ onSubmit='return CheckForm();'>" & vbCrLf
.Write "<input type=""hidden"" name=""action"" value=""step2"">" & vbCrLf
.Write "<input type=""hidden"" name=""ChannelID"" value=""" & ChannelID & """>" & vbCrLf
.Write "<input type=""hidden"" name=""ItemID"" value=""" & ItemID & """>" & vbCrLf
.Write "<input type=hidden name='change' value='yes'>" & vbNewLine
.Write "<table border=""0"" align=""center"" cellpadding=""3"" cellspacing=""1"" class=""TableBorder""> " & vbCrLf
.Write " <tr> " & vbCrLf
.Write " <th colspan=""2"">" & ItemTitle & "</th> " & vbCrLf
.Write " </tr> " & vbCrLf
If ItemID > 0 Then
SettingStep (ItemID)
End If
.Write " <tr> " & vbCrLf
.Write " <td width=""23%"" align=""right"" nowrap class=""TableRow1""><strong>项目名称：</strong></td> " & vbCrLf
.Write " <td width=""77%"" class=""TableRow1""><input name=""ItemName"" type=""text"" id=""ItemName"" size=""30"""
If isEdit Then .Write " value=""" & Rs("ItemName") & """"
.Write "></td> " & vbCrLf
.Write " </tr> " & vbCrLf
.Write " <tr> " & vbCrLf
.Write " <td align=""right"" class=""TableRow2""><strong>目标站点URL：</strong></td> " & vbCrLf
.Write " <td class=""TableRow2""><input name=""SiteUrl"" type=""text"" id=""SiteUrl"" size=""30"""
If isEdit Then
.Write " value=""" & Rs("SiteUrl") & """"
Else
.Write " value=""http://"""
End If
.Write "></td> " & vbCrLf
.Write " </tr> " & vbCrLf
.Write " <tr> " & vbCrLf
.Write " <td align=""right"" class=""TableRow1""><strong>所属分类：</strong></td> " & vbCrLf
.Write " <td class=""TableRow1""><select name=""ClassID"" size=""1"" id=""ClassID"">" & vbCrLf
sClassSelect = Newasp.LoadSelectClass(ChannelID)
If isEdit Then
sClassSelect = Replace(sClassSelect, "{ClassID=" & Rs("ClassID") & "}", "selected")
End If
.Write sClassSelect
.Write " </select></td> " & vbCrLf
.Write " </tr> " & vbCrLf
.Write " <tr> " & vbCrLf
.Write " <td align=""right"" class=""TableRow2""><strong>所属专题：</strong></td> " & vbCrLf
.Write " <td class=""TableRow2""><select name=""SpecialID"" size=""1"" id=""SpecialID"">" & vbCrLf
.Write " <option value=""0"">不指定专题</option>" & vbCrLf
Set RsObj = Newasp.Execute("SELECT SpecialID,SpecialName FROM NC_Special Where ChannelID = " & ChannelID & " ORDER BY orders")
Do While Not RsObj.EOF
.Write " <option value=""" & RsObj("SpecialID") & """"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -