📄 admin_articlegather.asp
字号:
.Write " <tr> " & vbCrLf
.Write " <td align=""right"" class=""TableRow1""><strong>获取连接开始代码：</strong></td> " & vbCrLf
.Write " <td class=""TableRow1""><textarea name=FindListCode2 rows=5 cols=80>"
.Write Server.HTMLEncode(strFindListCode(2))
.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=FindListCode3 rows=5 cols=80>"
.Write Server.HTMLEncode(strFindListCode(3))
.Write "</textarea></td> " & vbCrLf
.Write " </tr> " & vbCrLf
'--特殊设置开始
.Write " <tr> " & vbCrLf
.Write " <td align=""right"" class=""TableRow1""><strong>特殊设置：</strong></td> " & vbCrLf
.Write " <td class=""TableRow1""><div><Input type=""radio"" value=""0"" name=""FindListCode4"" onClick=""especial.style.display='none';"""
If Mynewasp.ChkNumeric(strFindListCode(4)) = 0 Then .Write " checked"
.Write "> 不作处理 <Input type=""radio"" value=""1"" name=""FindListCode4"" onClick=""especial.style.display='';"""
If Mynewasp.ChkNumeric(strFindListCode(4)) > 0 Then .Write " checked"
.Write " disabled> 重新定位"
.Write "</div><div id='especial' style=""display:none""><input type=""text"" name=""FindListCode5"" size=60 value='"
.Write Server.HTMLEncode(strFindListCode(5))
.Write "'></div>"
.Write "<div></div></td> " & vbCrLf
.Write " </tr> " & vbCrLf
'--特殊设置结束
.Write " <tr> " & vbCrLf
.Write " <td align=""right"" class=""TableRow2""></td> " & vbCrLf
.Write " <td class=""TableRow2"" align=""center"">"
.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 "</td> " & vbCrLf
.Write " </tr> " & vbCrLf
.Write "</table> " & vbCrLf
.Write "</form>" & vbCrLf
End With
End Sub
'--采集项目第三步
Private Sub ItemStep3()
Dim i, showcode
Dim tmpFindListCode
Dim strEncoding, NamedDemourl
Dim strRemoteLisCode, strRemoteListUrl
Dim strFindListCode, strFindInfoCode
ItemID = Mynewasp.ChkNumeric(Request("ItemID"))
showcode = Mynewasp.ChkNumeric(Request("showcode"))
If Trim(Request("change")) = "yes" Then
'--如果是更新项目，执行下面的操作
Mynewasp.DelCahe "NewsItem" & ItemID
For i = 0 To 5
tmpFindListCode = tmpFindListCode & Request.Form("FindListCode" & i & "") & "$$$"
Next
tmpFindListCode = tmpFindListCode & "0$$$0$$$0$$$0$$$0$$$0"
SQL = "SELECT ItemID,FindListCode FROM NC_NewsItem WHERE ChannelID=" & ChannelID & " And ItemID=" & ItemID
Set Rs = CreateObject("ADODB.Recordset")
Rs.Open SQL, MyConn, 1, 3
If Rs.BOF And Rs.EOF Then
OutErrors ("错误的系统参数！")
Set Rs = Nothing
Exit Sub
Else
Rs("FindListCode") = tmpFindListCode
Rs.Update
End If
Rs.Close: Set Rs = Nothing
End If
'--获取项目设置
SQL = "SELECT ItemID,Encoding,RemoteListUrl,FindListCode,FindInfoCode,IsNextPage,NamedDemourl FROM NC_NewsItem WHERE ChannelID=" & ChannelID & " And ItemID=" & ItemID
Set Rs = MyConn.Execute(SQL)
If Rs.BOF And Rs.EOF Then
OutErrors ("错误的系统参数！")
Set Rs = Nothing
Exit Sub
Else
strEncoding = Trim(Rs("Encoding"))
RemoteListUrl = Trim(Rs("RemoteListUrl"))
strFindListCode = Split(Mynewasp.ReplaceTrim(Rs("FindListCode")), "$$$")
strFindInfoCode = Split(Rs("FindInfoCode"), "$$$")
IsNextPage = Rs("IsNextPage")
If Not IsNull(Rs("NamedDemourl")) Then
NamedDemourl = Rs("NamedDemourl")
End If
End If
Rs.Close: Set Rs = Nothing
With Response
.Write "<form name=myform method=post action=""" & ScriptName & """>" & vbCrLf
.Write "<input type=""hidden"" name=""action"" value=""step4"">" & 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"">采集项目第三步</th> " & vbCrLf
.Write " </tr> " & vbCrLf
If ItemID > 0 Then
SettingStep (ItemID)
End If
'--如果选择了显示源码,开始获取远程信息
If showcode > 0 Then
'--获取远程列表网页源代码Mynewasp.ReplaceTrim(
HTTPHtmlCode = Mynewasp.ReplaceTrim(Mynewasp.GetRemoteData(RemoteListUrl, strEncoding))
If HTTPHtmlCode = "" Then
OutErrors ("获取远程信息出错！请确定你的远程列表URL输入无误。")
Exit Sub
End If
'--获取远程列表代码
strRemoteLisCode = Mynewasp.CutFixed(HTTPHtmlCode, strFindListCode(0), strFindListCode(1))
strRemoteLisCode = Mynewasp.ReplacedTrim(strRemoteLisCode)
If strRemoteLisCode = "" Then
OutErrors ("获取远程列表出错！请确定你的远程列表开始和结束代码输入无误。")
Exit Sub
End If
'--获取列表URL
strRemoteListUrl = Mynewasp.CutFixed(strRemoteLisCode, strFindListCode(2), strFindListCode(3))
strRemoteListUrl = Mynewasp.FormatRemoteUrl(RemoteListUrl, strRemoteListUrl)
If strRemoteListUrl = "" Then
OutErrors ("获取远程连接出错！请确定你的连接开始和结束代码输入无误。")
Exit Sub
End If
HTTPHtmlCode = Mynewasp.GetRemoteData(strRemoteListUrl, strEncoding)
If HTTPHtmlCode = "" Then
OutErrors ("获取远程信息出错！请确定你的远程连接代码输入无误。")
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='" & strRemoteListUrl & "' target='_blank'><font color='red'>" & strRemoteListUrl & "</font></a>"
.Write " <a href='view-source:" & strRemoteListUrl & "' 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"">项 目 编 辑 -- " & sModuleName & "信息设置</td> " & vbCrLf
.Write " </tr> " & vbCrLf
.Write " <td width='25%' align=""right"" class=""TableRow1""><strong>获取" & sModuleName & "标题开始代码：</strong></td> " & vbCrLf
.Write " <td width='75%' class=""TableRow1""><textarea name=FindInfoCode0 rows=5 cols=80>"
.Write Server.HTMLEncode(strFindInfoCode(0))
.Write "</textarea></td> " & vbCrLf
.Write " </tr> " & vbCrLf
.Write " <tr> " & vbCrLf
.Write " <td align=""right"" class=""TableRow2""><strong>获取" & sModuleName & "标题结束代码：</strong></td> " & vbCrLf
.Write " <td class=""TableRow2""><textarea name=FindInfoCode1 rows=5 cols=80>"
.Write Server.HTMLEncode(strFindInfoCode(1))
.Write "</textarea></td> " & vbCrLf
.Write " </tr> " & vbCrLf
.Write " <tr> " & vbCrLf
.Write " <td align=""right"" class=""TableRow1""><strong>获取" & sModuleName & "内容开始代码：</strong></td> " & vbCrLf
.Write " <td class=""TableRow1""><textarea name=FindInfoCode2 rows=5 cols=80>"
.Write Server.HTMLEncode(strFindInfoCode(2))
.Write "</textarea></td> " & vbCrLf
.Write " </tr> " & vbCrLf
.Write " <tr> " & vbCrLf
.Write " <td align=""right"" class=""TableRow2""><strong>获取" & sModuleName & "内容结束代码：</strong></td> " & vbCrLf
.Write " <td class=""TableRow2""><textarea name=FindInfoCode3 rows=5 cols=80>"
.Write Server.HTMLEncode(strFindInfoCode(3))
.Write "</textarea></td> " & vbCrLf
.Write " </tr> " & vbCrLf
'--分类设置 可选项
.Write " <tr> " & vbCrLf
.Write " <td align=""right"" class=""TableRow2""><strong>" & sModuleName & "分类设置(可选项)：</strong></td> " & vbCrLf
.Write " <td class=""TableRow2"">"
.Write "<Input type=""radio"" value=""0"" name=""selClass"" onClick=""InfoCode4.style.display='none';InfoCode5.style.display='none';InfoCode6.style.display='none';InfoCode7.style.display='none';"" checked> 分类设置窗口 "
.Write "<Input type=""radio"" value=""1"" name=""selClass"" onClick=""InfoCode4.style.display='';InfoCode5.style.display='';InfoCode6.style.display='';InfoCode7.style.display='';""> 打开设置窗口 "
.Write "<font color='red'>* 如果第一步设置了自动归类，请设置此项</font>"
.Write "</td> " & vbCrLf
.Write " </tr> " & vbCrLf
.Write " <tr id=""InfoCode4"" style=""display:'none';""> " & vbCrLf
.Write " <td align=""right"" class=""TableRow1""><strong>获取父分类名称开始代码：</strong><br><font color='blue'>不获取分类请输入“0”</font></td> " & vbCrLf
.Write " <td class=""TableRow1""><textarea name=FindInfoCode4 rows=5 cols=80>"
.Write Server.HTMLEncode(strFindInfoCode(4))
.Write "</textarea></td> " & vbCrLf
.Write " </tr> " & vbCrLf
.Write " <tr id=""InfoCode5"" style=""display:'none';""> " & vbCrLf
.Write " <td align=""right"" class=""TableRow2""><strong>获取父分类名称结束代码：</strong><br><font color='blue'>手动设置，请直接输入分类名称</font></td> " & vbCrLf
.Write " <td class=""TableRow2""><textarea name=FindInfoCode5 rows=5 cols=80>"
.Write Server.HTMLEncode(strFindInfoCode(5))
.Write "</textarea></td> " & vbCrLf
.Write " </tr> " & vbCrLf
.Write " <tr id=""InfoCode6"" style=""display:'none';""> " & vbCrLf
.Write " <td align=""right"" class=""TableRow1""><strong>获取子分类名称开始代码：</strong><br><font color='blue'>不获取分类请输入“0”</font></td> " & vbCrLf
.Write " <td class=""TableRow1""><textarea name=FindInfoCode6 rows=5 cols=80>"
.Write Server.HTMLEncode(strFindInfoCode(6))
.Write "</textarea></td> " & vbCrLf
.Write " </tr> " & vbCrLf
.Write " <tr id=""InfoCode7"" style=""display:'none';""> " & vbCrLf
.Write " <td align=""right"" class=""TableRow2""><strong>获取子分类名称结束代码：</strong><br><font color='blue'>手动设置，请直接输入分类名称</font></td> " & vbCrLf
.Write " <td class=""TableRow2""><textarea name=FindInfoCode7 rows=5 cols=80>"
.Write Server.HTMLEncode(strFindInfoCode(7))
.Write "</textarea></td> " & vbCrLf
.Write " </tr> " & vbCrLf
'--文章作者设置
.Write " <tr> " & vbCrLf
.Write " <td align=""right"" class=""TableRow2""><strong>" & sModuleName & "作者设置：</strong></td> " & vbCrLf
.Write " <td class=""TableRow2"">"
.Write "<Input type=""radio"" value=""0"" name=""selfont8"" onClick=""InfoCode8.style.display='none';InfoCode9.style.display='none';"" checked> 隐藏设置窗口 "
.Write "<Input type=""radio"" value=""1"" name=""selfont8"" onClick=""InfoCode8.style.display='';InfoCode9.style.display='';"">打开设置窗口 "
.Write "<font color='blue'>* 如果指定作者,开始代码填“0”，结束代码填作者名称</font>"
.Write "</td> " & vbCrLf
.Write " </tr> " & vbCrLf
.Write " <tr id=""InfoCode8"" style=""display:'none';""> " & vbCrLf
.Write " <td align=""right"" class=""TableRow1""><strong><font color=""blue"">获取" & sModuleName & "作者开始代码：</font></strong></td> " & vbCrLf
.Write " <td class=""TableRow1""><textarea name=FindInfoCode8 rows=5 cols=80>"
.Write Server.HTMLEncode(strFindInfoCode(8))
.Write "</textarea></td> " & vbCrLf
.Write " </tr> " & vbCrLf
.Write " <tr id=""InfoCode9"" style=""display:'none';""> " & vbCrLf
.Write " <td align=""right"" class=""TableRow2""><strong><font color=""blue"">获取" & sModuleName & "作者结束代码：</font></strong></td> " & vbCrLf
.Write " <td class=""TableRow2""><textarea name=FindInfoCode9 rows=5 cols=80>"
.Write Server.HTMLEncode(strFindInfoCode(9))
.Write "</textarea></td> " & vbCrLf
.Write " </tr> " & vbCrLf
'--文章来源设置
.Write " <tr> " & vbCrLf
.Write " <td align=""right"" class=""TableRow2""><strong>" & sModuleName & "来源设置：</strong></td> " & vbCrLf
.Write " <td class=""TableRow2"">"
.Write "<Input type=""radio"" value=""0"" name=""selfont10"" onClick=""InfoCode10.style.display='none';InfoCode11.style.display='none';"" checked> 隐藏设置窗口 "
.Write "<Input type=""radio"" value=""1"" name=""selfont10"" onClick=""InfoCode10.style.display='';InfoCode11.style.display='';"">打开设置窗口 "
.Write "<font color='blue'>* 如果要指定来源,开始代码填“0”，结束代码填来源</font>"
.Write "</td> " & vbCrLf
.Write " </tr> " & vbCrLf
.Write " <tr id=""InfoCode10"" style=""display:'none';""> " & vbCrLf
.Write " <td align=""right"" class=""TableRow1""><strong>获取" & sModuleName & "来源开始代码：</strong></td> " & vbCrLf
.Write " <td class=""TableRow1""><textarea name=FindInfoCode10 rows=5 cols=80>"
.Write Server.HTMLEncode(strFindInfoCode(10))
.Write "</textarea></td> " & vbCrLf
.Write " </tr> " & vbCrLf
.Write " <tr id=""InfoCode11"" style=""display:'none';""> " & vbCrLf
.Write " <td align=""right"" class=""TableRow2""><strong>获取" & sModuleName & "来源结束代码：</strong></td> " & vbCrLf
.Write " <td class=""TableRow2""><textarea name=FindInfoCode11 rows=5 cols=80>"
.Write Server.HTMLEncode(strFindInfoCode(11))
.Write "</textarea></td> " & vbCrLf
.Write " </tr> " & vbCrLf
'--更新时间设置
.Write " <tr> " & vbCrLf
.Write " <td align=""right"" class=""TableRow2""><strong>" & sModuleName & "更新时间设置：</strong></td> " & vbCrLf
.Write " <td class=""TableRow2"">"
.Write "<Input type=""radio"" value=""0"" name=""selfont12"" onClick=""InfoCode12.style.display='none';InfoCode13.style.display='none';"" checked> 隐藏设置窗口 "
.Write "<Input type=""radio"" value=""1"" name=""selfont12"" onClick=""InfoCode12.style.display='';InfoCode13.style.display='';"">打开设置窗口 "
.Write "<font color='blue'>* 如果第一步设置显示为最新时间，此设置无效</font>"
.Write "</td> " & vbCrLf
.Write " </tr> " & vbCrLf
.Write " <tr id=""InfoCode12"" style=""display:'none';""> " & vbCrLf
.Write " <td align=""right"" class=""TableRow1""><strong>获取更新时间开始代码：</strong><br><font color='blue'>不设置请输入“0”</font></td> " & vbCrLf
.Write " <td class=""TableRow1""><textarea name=FindInfoCode12 rows=5 cols=80>"
.Write Server.HTMLEncode(strFindInfoCode(12))
.Write "</textarea></td> " & vbCrLf
.Write " </tr> " & vbCrLf
.Write " <tr id=""InfoCode13"" style=""display:'none';""> " & vbCrLf
.Write " <td align=""right"" class=""TableRow2""><strong>获取更新时间结束代码：</strong><br><font color='blue'>不设置请输入“0”</font></td> " & vbCrLf
.Write " <td class=""TableRow2""><textarea name=FindInfoCode13 rows=5 cols=80>"
.Write Server.HTMLEncode(strFindInfoCode(13))
.Write "</textarea></td> " & vbCrLf
.Write " </tr> " & vbC⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -