📄 admin_articlegather.asp
字号:
End If
.Write "> " & vbCrLf
.Write " FORM " & vbCrLf
.Write " <input name=""RemoveCode10"" type=""checkbox"" value=""1"""
If isEdit Then
If Mynewasp.ChkNumeric(ArrayRemoveCode(10)) = 1 Then .Write " checked"
End If
.Write "> " & vbCrLf
.Write " HTML </td>" & vbCrLf
.Write " </tr>" & vbCrLf
.Write " <tr>" & vbCrLf
.Write " <td align=""right"" class=""TableRow1""><strong class=""TableRow2"">远程列表URL：</strong></td>" & vbCrLf
.Write " <td class=""TableRow2""><span class=""TableRow1"">" & vbCrLf
.Write " <input name=""RemoteListUrl"" type=""text"" id=""RemoteListUrl"" size=""70"""
If isEdit Then
.Write " value=""" & Rs("RemoteListUrl") & """"
End If
.Write ">" & vbCrLf
.Write " </span></td>" & vbCrLf
.Write " </tr>" & vbCrLf
.Write " <tr>" & vbCrLf
.Write " <td align=""right"" class=""TableRow1""><strong class=""TableRow1"">是否列表分页采集：</strong></td>" & vbCrLf
.Write " <td class=""TableRow1""><input name=""IsPagination"" type=""radio"" value=""0"""
If isEdit Then
If Rs("IsPagination") = 0 Then .Write " checked"
Else
.Write " checked"
End If
.Write " onClick=""Pageinate1.style.display='none';Pageinate2.style.display='none';""> 否 " & vbCrLf
.Write " <input type=""radio"" name=""IsPagination"" value=""1"""
If isEdit Then
If Rs("IsPagination") > 0 Then .Write " checked"
End If
.Write " onClick=""Pageinate1.style.display='';Pageinate2.style.display='';""> 是</td>" & vbCrLf
.Write " </tr>" & vbCrLf
.Write " <tr id=""Pageinate1"""
If isEdit Then
If Rs("IsPagination") = 0 Then .Write " style=""display:'none';"""
Else
.Write " style=""display:'none';"""
End If
.Write ">" & vbCrLf
.Write " <td align=""right"" class=""TableRow2""><strong class=""TableRow2"">远程列表分页URL：</strong></td>" & vbCrLf
.Write " <td class=""TableRow2""><input name=""PaginalList"" type=""text"" id=""PaginalList"" size=""70"""
If isEdit Then
.Write " value=""" & Rs("PaginalList") & """"
End If
.Write ">" & vbCrLf
.Write " <span class=""style2""> * 分页代码 <font color=""red"">{$pageid}</font></span></td>" & vbCrLf
.Write " </tr>" & vbCrLf
.Write " <tr id=""Pageinate2"""
If isEdit Then
If Rs("IsPagination") = 0 Then .Write " style=""display:'none';"""
Else
.Write " style=""display:'none';"""
End If
.Write ">" & vbCrLf
.Write " <td align=""right"" class=""TableRow1""><strong class=""TableRow1"">远程列表起始页：</strong></td>" & vbCrLf
.Write " <td class=""TableRow1"">开始页：" & vbCrLf
.Write " <input name=""startid"" type=""text"" id=""startid"" size=""6"""
If isEdit Then
.Write " value=""" & Rs("startid") & """"
Else
.Write " value=""1"""
End If
.Write "> -" & vbCrLf
.Write " 结束页：" & vbCrLf
.Write " <input name=""lastid"" type=""text"" id=""lastid"" size=""6"""
If isEdit Then
.Write " value=""" & Rs("lastid") & """"
Else
.Write " value=""2"""
End If
.Write "> <span class=""style2"">* 例如：1 - 9 或者 9 - 1</span></td>" & vbCrLf
.Write " </tr>" & vbCrLf
'--内容字符替换操作
.Write " <tr>" & vbCrLf
.Write " <td align=""right"" class=""TableRow2""><strong>内容字符替换操作：</strong></td>" & vbCrLf
.Write " <td class=""TableRow2""><table border=""0"" cellpadding=""3""><tr><td><select name=""strReplace"" id=""strReplace"" style=""width:380;height:100"" size=""2"" ondblclick=""return ModifyReplace();"">" & vbCrLf
Dim strReplaceArray
If isEdit Then
If Not IsNull(Rs("strReplace")) Then
strReplaceArray = Split(Rs("strReplace"), "$$$")
For i = 0 To UBound(strReplaceArray)
If Len(strReplaceArray(i)) > 1 Then
.Write " <option value=""" & strReplaceArray(i) & """>" & strReplaceArray(i) & "</option>" & vbCrLf
End If
Next
End If
End If
.Write " " & vbCrLf
.Write " </select></td><td>" & vbCrLf
.Write " <input type=""button"" name=""addreplace"" value=""添加替换字符"" class=""button"" onclick=""AddReplace();""><br><br style=""overflow: hidden; line-height: 5px"">" & vbCrLf
.Write " <input type=""button"" name=""modifyreplace"" value=""修改当前字符"" class=""button"" onclick=""return ModifyReplace();""><br><br style=""overflow: hidden; line-height: 5px"">" & vbCrLf
.Write " <input type=""button"" name=""delreplace"" value=""删除当前字符"" class=""button"" onclick=""DelReplace();""><br>" & vbCrLf
.Write " <input type=""hidden"" name=""ReplaceList"" value="""">" & vbCrLf
.Write " </td><tr></table>" & vbCrLf
.Write " </td>" & vbCrLf
.Write " </tr>" & vbCrLf
.Write " <tr>" & vbCrLf
.Write " <td align=""right"" class=""TableRow1""> </td>" & vbCrLf
.Write " <td class=""TableRow1""><div align=""center"">" & vbCrLf
.Write " <input name=""B12"" type=""button"" class=""Button"" onclick=""javascript:history.go(-1)"" value=""返回上一页""> " & vbCrLf
.Write " <input name=""B22"" type=""submit"" class=""Button"" value="" 下一步 ""> " & vbCrLf
.Write " <input name=""ShowCode"" type=""checkbox"" value=""1""> 显示源码" & vbCrLf
.Write " </div></td>" & vbCrLf
.Write " </tr> " & vbCrLf
.Write "</table> " & vbCrLf
.Write "</form>" & vbCrLf
If isEdit Then Rs.Close: Set Rs = Nothing
End With
End Sub
Private Sub ItemStep2()
Dim tmpRemoveCode, i, showcode
Dim NewItemID, strFindListCode
ItemID = Mynewasp.ChkNumeric(Request("ItemID"))
showcode = Mynewasp.ChkNumeric(Request("showcode"))
If Trim(Request("change")) = "yes" Then
If Len(Trim(Request.Form("ItemName"))) = 0 Then
OutErrors ("请填写项目名称！")
Exit Sub
End If
If Len(Trim(Request.Form("SiteUrl"))) = 0 Then
OutErrors ("请填写目标站点URL！")
Exit Sub
End If
If Left(LCase(Request.Form("SiteUrl")), 4) <> "http" Then
OutErrors ("目标站点URL输入错误，请在URL前面加上“http://”！")
Exit Sub
End If
If Len(Trim(Request.Form("Encoding"))) < 3 Then
OutErrors ("请选择目标站点的文件编码！")
Exit Sub
End If
If Mynewasp.ChkNumeric(Request.Form("AutoClass")) = 0 Then
If Mynewasp.ChkNumeric(Request.Form("ClassID")) = 0 Then
OutErrors ("该一级分类已经有下属分类，不能采集；请重新选择分类！")
Exit Sub
End If
End If
If Len(Trim(Request.Form("RemoteListUrl"))) = 0 Then
OutErrors ("请填写远程列表URL！")
Exit Sub
End If
If Mynewasp.ChkNumeric(Request.Form("IsPagination")) > 0 Then
If Len(Trim(Request.Form("PaginalList"))) = 0 Then
OutErrors ("请填写远程分页列表URL！")
Exit Sub
End If
End If
Mynewasp.DelCahe "NewsItem" & ItemID
For i = 0 To 10
tmpRemoveCode = tmpRemoveCode & Mynewasp.ChkNumeric(Request.Form("RemoveCode" & i & "")) & "|"
Next
tmpRemoveCode = tmpRemoveCode & "0|0|0|0|0|0|0|0|0"
If ItemID = 0 Then
SQL = "SELECT * FROM NC_NewsItem WHERE (ItemID is null)"
Else
SQL = "SELECT * FROM NC_NewsItem WHERE ItemID=" & ItemID
End If
Set Rs = CreateObject("ADODB.Recordset")
Rs.Open SQL, MyConn, 1, 3
If ItemID = 0 Then Rs.AddNew
Rs("ItemName") = Trim(Request.Form("ItemName"))
Rs("SiteUrl") = Trim(Request.Form("SiteUrl"))
Rs("ChannelID") = ChannelID
Rs("ClassID") = Mynewasp.ChkNumeric(Request.Form("ClassID"))
Rs("SpecialID") = Mynewasp.ChkNumeric(Request.Form("SpecialID"))
Rs("StopItem") = Mynewasp.ChkNumeric(Request.Form("StopItem"))
Rs("Encoding") = Trim(Request.Form("Encoding"))
Rs("IsDown") = Mynewasp.ChkNumeric(Request.Form("IsDown"))
Rs("AutoClass") = Mynewasp.ChkNumeric(Request.Form("AutoClass"))
Rs("PathForm") = Mynewasp.ChkNumeric(Request.Form("PathForm"))
Rs("IsNowTime") = Mynewasp.ChkNumeric(Request.Form("IsNowTime"))
Rs("AllHits") = Mynewasp.ChkNumeric(Request.Form("AllHits"))
Rs("star") = Mynewasp.ChkNumeric(Request.Form("star"))
Rs("RemoveCode") = Trim(tmpRemoveCode)
Rs("RemoteListUrl") = Trim(Request.Form("RemoteListUrl"))
Rs("PaginalList") = Trim(Request.Form("PaginalList"))
Rs("IsPagination") = Mynewasp.ChkNumeric(Request.Form("IsPagination"))
Rs("startid") = Mynewasp.ChkNumeric(Request.Form("startid"))
Rs("lastid") = Mynewasp.ChkNumeric(Request.Form("lastid"))
If ItemID = 0 Then
Rs("lastime") = Now()
Rs("FindListCode") = "0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0"
Rs("FindInfoCode") = "0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0$$$0"
Rs("IsNextPage") = 0
Rs("NamedDemourl") = ""
End If
Rs("RetuneClass") = Trim(Request.Form("ClassList"))
Rs("strReplace") = Trim(Request.Form("ReplaceList"))
Rs.Update
Rs.Close: Set Rs = Nothing
End If
Set Rs = CreateObject("ADODB.Recordset")
If ItemID = 0 Then
Rs.Open "SELECT TOP 1 ItemID,FindListCode FROM NC_NewsItem WHERE ChannelID=" & ChannelID & " ORDER BY ItemID DESC", MyConn, 1, 1
Else
Rs.Open "SELECT ItemID,FindListCode FROM NC_NewsItem WHERE ChannelID=" & ChannelID & " And ItemID=" & ItemID & "", MyConn, 1, 1
End If
NewItemID = Rs("ItemID")
strFindListCode = Split(Rs("FindListCode"), "$$$")
Rs.Close: Set Rs = Nothing
With Response
.Write "<form name=myform method=post action=""" & ScriptName & """>" & vbCrLf
.Write "<input type=""hidden"" name=""action"" value=""step3"">" & vbCrLf
.Write "<input type=""hidden"" name=""ChannelID"" value=""" & ChannelID & """>" & vbCrLf
.Write "<input type=""hidden"" name=""ItemID"" value=""" & NewItemID & """>" & 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"">采集项目第二步</th> " & vbCrLf
.Write " </tr> " & vbCrLf
If ItemID > 0 Then
SettingStep (ItemID)
End If
'--如果选择了显示源码
If showcode > 0 Then
HTTPHtmlCode = Mynewasp.GetRemoteData(Trim(Request.Form("RemoteListUrl")), Trim(Request.Form("Encoding")))
If HTTPHtmlCode = "" Then
.Write "<script language=""javascript"">" & vbCrLf
.Write "alert('获取远程信息出错！请确定你的远程列表URL输入无误。');"
.Write "location.replace('?action=edit&" & ChannelID & "=1&ItemID=" & NewItemID & "');" & vbCrLf
.Write "</script>" & vbCrLf
Exit Sub
End If
.Write " <tr> " & vbCrLf
.Write " <td class=""TableTitle"" align=""center"" colspan=""2"">项 目 编 辑 -- 采集目标网站源代码 "
.Write "<Input type=""radio"" value=""0"" name=""soucode"" onClick=""soucodeid.style.display='none';""> 关闭源代码窗口 <Input type=""radio"" value=""1"" name=""soucode"" onClick=""soucodeid.style.display='';"" checked> 查看源代码"
.Write " </td> " & vbCrLf
.Write " </tr> " & vbCrLf
.Write " <tr> " & vbCrLf
.Write " <td class=""TableRow1"" colspan=""2"" id='soucodeid'><textarea name='content' id='content' wrap='OFF' style='width:100%;' rows='20'>"
.Write Server.HTMLEncode(HTTPHtmlCode)
.Write "</textarea><div align='right'><a href=""javascript:admin_Size(-20,'content')""><img src='images/minus.gif' unselectable=on border=0></a> <a href=""javascript:admin_Size(20,'content')""><img src='images/plus.gif' unselectable=on border=0></div></td> " & vbCrLf
.Write " </tr> " & vbCrLf
.Write " <tr> " & vbCrLf
.Write " <td class=""TableRow2"" colspan=""2"">"
.Write "采集的目标地址 → <a href='" & Trim(Request.Form("RemoteListUrl")) & "' target='_blank'><font color='red'>" & Trim(Request.Form("RemoteListUrl")) & "</font></a>"
.Write " <a href='view-source:" & Trim(Request.Form("RemoteListUrl")) & "' target='_blank'><font color='blue'>点击查看目标源代码</font></a></td> " & vbCrLf
.Write " </tr> " & vbCrLf
End If
.Write " <tr> " & vbCrLf
.Write " <td class=""TableTitle"" align=""center"" colspan=""2"">项 目 编 辑 -- 列表连接设置</td> " & vbCrLf
.Write " </tr> " & vbCrLf
.Write " <tr> " & vbCrLf
.Write " <td width='25%' align=""right"" class=""TableRow1""><strong>获取列表开始代码：</strong></td> " & vbCrLf
.Write " <td width='75%' class=""TableRow1""><textarea name=FindListCode0 rows=5 cols=80>"
.Write Server.HTMLEncode(strFindListCode(0))
.Write "</textarea></td> " & vbCrLf
.Write " </tr> " & vbCrLf
.Write " <tr> " & vbCrLf
.Write " <td align=""right"" class=""TableRow2""><strong>获取列表结束代码：</strong></td> " & vbCrLf
.Write " <td class=""TableRow2""><textarea name=FindListCode1 rows=5 cols=80>"
.Write Server.HTMLEncode(strFindListCode(1))
.Write "</textarea></td> " & vbCrLf
.Write " </tr> " & vbCrLf
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -