📄 collection.asp
字号:
Call CheckSave
End If
If FoundErr = True Then Exit Sub
Set Rs = CreateObject("ADODB.Recordset")
If Trim(Request("ItemID")) <> 0 And Trim(Request("ItemID")) <> "" Then
SQL = "SELECT * FROM NC_CollectArticle WHERE id=" & CLng(Request("ItemID"))
Else
SQL = "SELECT * FROM NC_CollectArticle WHERE (id is null)"
End If
Rs.Open SQL, MyConn, 1, 3
If Trim(Request("change")) = "yes" Then
If Trim(Request("ItemID")) = 0 Then
Rs.AddNew
Rs("RemoteListStr") = "$$$$$$$$$"
Rs("LastTime") = Now
Rs("RemoteContent") = "$$$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"
End If
Rs("ChannelID") = Trim(Request.Form("ChannelID"))
Rs("SpecialID") = Trim(Request.Form("SpecialID"))
Rs("ClassID") = Trim(Request.Form("ClassID"))
Rs("ItemName") = Trim(Request.Form("ItemName"))
Rs("WebSiteName") = Trim(Request.Form("WebSiteName"))
Rs("WebSiteUrl") = Trim(strWebSiteUrl)
Rs("RemoteListUrl") = Trim(Request.Form("RemoteListUrl"))
Rs("MaxListPage") = Trim(Request.Form("MaxListPage"))
Rs("SaveRemotePic") = Trim(Request.Form("SaveRemotePic"))
Rs("Estate") = Trim(Request.Form("Estate"))
Rs("UserGroup") = Trim(Request.Form("UserGroup"))
Rs("PointNum") = Trim(Request.Form("PointNum"))
Rs("AllHits") = Trim(Request.Form("AllHits"))
Rs("star") = Trim(Request.Form("star"))
Rs("isTop") = ArticleTop
Rs("isBest") = ArticleBest
Rs("ForbidEssay") = ForbidEssay
Rs("WriteTime") = Trim(Request.Form("WriteTime"))
Rs.Update
End If
ItemID = Rs("id")
RemoteListStr = Split(Rs("RemoteListStr"), "$$$")
RemoteListUrl = Replace(Replace(Rs("RemoteListUrl"), "{$PageCode}", 1, 1, -1, 1), "*", 1)
If Not CheckRemoteUrl(RemoteListUrl) Then
RemoteListUrl = Replace(Replace(Replace(Replace(Rs("RemoteListUrl"), "{$PageCode}", "", 1, -1, 1), "_", ""), "-", ""), "*", "")
If Not CheckRemoteUrl(RemoteListUrl) Then
Dim sHtmlExtName, HtmlExtName, strListUrl, TempListUrl
sHtmlExtName = Split(RemoteListUrl, ".")
HtmlExtName = sHtmlExtName(UBound(sHtmlExtName))
strListUrl = Split(RemoteListUrl, "/")
TempListUrl = strListUrl(UBound(strListUrl))
TempListUrl = Left(RemoteListUrl, Len(RemoteListUrl) - Len(TempListUrl))
RemoteListUrl = TempListUrl & "index." & HtmlExtName
End If
End If
If Not CheckRemoteUrl(RemoteListUrl) Then
RemoteListUrl = Replace(Replace(Rs("RemoteListUrl"), "{$PageCode}", 2, 1, -1, 1), "*", 2)
End If
MaxListPage = Rs("MaxListPage")
Rs.Close
Set Rs = Nothing
RemoteHtmlCode = GetHTTPPage(RemoteListUrl)
Response.Write "<table border=0 align=center cellpadding=3 cellspacing=1 class=tableborder>" & vbNewLine
Response.Write "<tr>" & vbNewLine
Response.Write " <th colspan=2>编辑采集项目 第二步</th>" & vbNewLine
Response.Write "</tr>" & vbNewLine
Call SettingStep(Request("ItemID"))
Response.Write "<form name=myform method=post action='admin_collect.asp?action=itemstep3'>" & vbNewLine
Response.Write "<input type=hidden name=ItemID value='"
Response.Write ItemID
Response.Write "'>" & vbNewLine
Response.Write "<input type=hidden name=ChannelID value='"
Response.Write ChannelID
Response.Write "'>" & vbNewLine
Response.Write "<input type=hidden name=change value='yes'>" & vbNewLine
Response.Write "<tr align=center>" & vbNewLine
Response.Write " <td class=TableTitle colspan=2>采集项目编辑----采集目标网页源码</td>" & vbNewLine
Response.Write "</tr>" & vbNewLine
Response.Write "<tr>" & vbNewLine
Response.Write " <td class=tablerow1 colspan=2><textarea name='content' wrap='OFF' style='width:100%;height:300px'>"
Response.Write Server.HTMLEncode(RemoteHtmlCode)
Response.Write "</textarea></td>" & vbNewLine
Response.Write "</tr>" & vbNewLine
Response.Write "<tr>" & vbNewLine
Response.Write " <td colspan=2 class=tablerow1>采集目标地址 -- "
Response.Write "<a href='" & RemoteListUrl & "' target=_blank><font color=red>" & RemoteListUrl & "</font></a> "
Response.Write " -- 请查看是否正确</td>" & vbNewLine
Response.Write "</tr>" & vbNewLine
Response.Write "<tr align=center>" & vbNewLine
Response.Write " <td class=TableTitle colspan=2>采集项目编辑----采集列表设置</td>" & vbNewLine
Response.Write "</tr>" & vbNewLine
Response.Write "<tr>" & vbNewLine
Response.Write " <td class=tablerow1><strong>列表开始代码：</strong></td>" & vbNewLine
Response.Write " <td class=tablerow1><textarea name=RemoteListStr0 rows=5 cols=70>"
Response.Write Server.HTMLEncode(RemoteListStr(0))
Response.Write "</textarea></td>" & vbNewLine
Response.Write "</tr>" & vbNewLine
Response.Write "<tr>" & vbNewLine
Response.Write " <td width='25%' class=tablerow1><strong>列表结束代码：</strong></td>" & vbNewLine
Response.Write " <td width='75%' class=tablerow1><textarea name=RemoteListStr1 rows=5 cols=70>"
Response.Write Server.HTMLEncode(RemoteListStr(1))
Response.Write "</textarea></td>" & vbNewLine
Response.Write "</tr>" & vbNewLine
Response.Write "<textarea name=RemoteListStr2 style=""display:none"">"
Response.Write Server.HTMLEncode(RemoteListStr(2))
Response.Write "</textarea>" & vbNewLine
Response.Write "<textarea name=RemoteListStr3 style=""display:none"">"
Response.Write Server.HTMLEncode(RemoteListStr(3))
Response.Write "</textarea>" & vbNewLine
Response.Write "<tr align=center>" & vbNewLine
Response.Write " <td class=tablerow1></td>" & vbNewLine
Response.Write " <td class=tablerow1>" & vbNewLine
Response.Write " <input type=button name=Submit4 onclick=""javascript:history.go(-1)"" value='返回上一页' class=Button> " & vbNewLine
Response.Write " <input type=submit value='下一步' class=button></td>" & vbNewLine
Response.Write "</tr>" & vbNewLine
Response.Write "</form>" & vbNewLine
Response.Write "</table>" & vbNewLine
End Sub
'=================================================
'过程名：ItemStep3
'作 用：项目设置第三步
'=================================================
Private Sub ItemStep3()
Dim RemoteListStr
Dim RemoteListUrl
Dim RemoteHtmlCode
Dim RemoteListCode
Dim Rs
Dim SQL
If Trim(Request("ItemID")) = "" Then
FoundErr = True
ErrMsg = ErrMsg + "<li>错误的系统参数！</li>"
End If
If FoundErr = True Then Exit Sub
Set Rs = CreateObject("ADODB.Recordset")
SQL = "SELECT * FROM NC_CollectArticle WHERE id=" & CLng(Request("ItemID"))
Rs.Open SQL, MyConn, 1, 3
If Trim(Request("change")) = "yes" Then
Rs("RemoteListStr") = Request.Form("RemoteListStr0") & "$$$" & Request.Form("RemoteListStr1") & "$$$" & Request.Form("RemoteListStr2") & "$$$" & Request.Form("RemoteListStr3")
Rs.Update
End If
ItemID = Rs("id")
RemoteListUrl = Replace(Replace(Rs("RemoteListUrl"), "{$PageCode}", 1, 1, -1, 1), "*", 1)
If Not CheckRemoteUrl(RemoteListUrl) Then
RemoteListUrl = Replace(Replace(Replace(Replace(Rs("RemoteListUrl"), "{$PageCode}", "", 1, -1, 1), "_", ""), "-", ""), "*", "")
If Not CheckRemoteUrl(RemoteListUrl) Then
Dim sHtmlExtName, HtmlExtName, strListUrl, TempListUrl
sHtmlExtName = Split(RemoteListUrl, ".")
HtmlExtName = sHtmlExtName(UBound(sHtmlExtName))
strListUrl = Split(RemoteListUrl, "/")
TempListUrl = strListUrl(UBound(strListUrl))
TempListUrl = Left(RemoteListUrl, Len(RemoteListUrl) - Len(TempListUrl))
RemoteListUrl = TempListUrl & "index." & HtmlExtName
End If
End If
If Not CheckRemoteUrl(RemoteListUrl) Then
RemoteListUrl = Replace(Replace(Rs("RemoteListUrl"), "{$PageCode}", 2, 1, -1, 1), "*", 2)
End If
RemoteListStr = Split(Rs("RemoteListStr"), "$$$")
Rs.Close
Set Rs = Nothing
RemoteHtmlCode = GetHTTPPage(RemoteListUrl)
RemoteListCode = CutFixContent(RemoteHtmlCode, RemoteListStr(0), RemoteListStr(1), 0)
If RemoteListCode = "" Then
FoundErr = True
ErrMsg = ErrMsg + "<li>在截取文章" & RemoteListUrl & "发生错误；</li>"
ErrMsg = ErrMsg + "<li>请查看你的截取代码是否正确！</li>"
Exit Sub
End If
Response.Write "<table border=0 align=center cellpadding=3 cellspacing=1 class=tableborder>" & vbNewLine
Response.Write "<tr>" & vbNewLine
Response.Write " <th colspan=2>编辑采集项目 第三步</th>" & vbNewLine
Response.Write "</tr>" & vbNewLine
Call SettingStep(Request("ItemID"))
Response.Write "<form name=myform method=post action='admin_collect.asp?action=itemstep4'>" & vbNewLine
Response.Write "<input type=hidden name=ItemID value='"
Response.Write ItemID
Response.Write "'>" & vbNewLine
Response.Write "<input type=hidden name=ChannelID value='"
Response.Write ChannelID
Response.Write "'>" & vbNewLine
Response.Write "<input type=hidden name=change value='yes'>" & vbNewLine
Response.Write "<tr align=center>" & vbNewLine
Response.Write " <td class=TableTitle colspan=2>采集项目编辑----采集目标网页源码</td>" & vbNewLine
Response.Write "</tr>" & vbNewLine
Response.Write "<tr>" & vbNewLine
Response.Write " <td class=tablerow1 colspan=2><textarea name='content' style='width:100%;height:300px'>"
Response.Write Server.HTMLEncode(RemoteListCode)
Response.Write "</textarea></td>" & vbNewLine
Response.Write "</tr>" & vbNewLine
Response.Write "<tr>" & vbNewLine
Response.Write " <td colspan=2 class=tablerow1>采集目标地址 -- "
Response.Write "<a href='" & RemoteListUrl & "' target=_blank><font color=red>" & RemoteListUrl & "</font></a> "
Response.Write " -- 请查看是否正确</td>" & vbNewLine
Response.Write "</tr>" & vbNewLine
Response.Write "<tr align=center>" & vbNewLine
Response.Write " <td class=TableTitle colspan=2>采集项目编辑----采集列表设置</td>" & vbNewLine
Response.Write "</tr>" & vbNewLine
Response.Write "<tr>" & vbNewLine
Response.Write " <td width='25%' class=tablerow1><strong>列表连接开始代码：</strong></td>" & vbNewLine
Response.Write " <td width='75%' class=tablerow1><textarea name=RemoteListStr2 rows=5 cols=50>"
Response.Write Server.HTMLEncode(RemoteListStr(2))
Response.Write "</textarea></td>" & vbNewLine
Response.Write "</tr>" & vbNewLine
Response.Write "<tr>" & vbNewLine
Response.Write " <td class=tablerow1><strong>列表连接结束代码：</strong></td>" & vbNewLine
Response.Write " <td class=tablerow1><textarea name=RemoteListStr3 rows=5 cols=50>"
Response.Write Server.HTMLEncode(RemoteListStr(3))
Response.Write "</textarea></td>" & vbNewLine
Response.Write "</tr>" & vbNewLine
Response.Write "<textarea name=RemoteListStr0 style=""display:none"">"
Response.Write Server.HTMLEncode(RemoteListStr(0))
Response.Write "</textarea>" & vbNewLine
Response.Write "<textarea name=RemoteListStr1 style=""display:none"">"
Response.Write Server.HTMLEncode(RemoteListStr(1))
Response.Write "</textarea>" & vbNewLine
Response.Write "<tr align=center>" & vbNewLine
Response.Write " <td class=tablerow1></td>" & vbNewLine
Response.Write " <td class=tablerow1>" & vbNewLine
Response.Write " <input type=button name=Submit4 onclick=""javascript:history.go(-1)"" value='返回上一页' class=Button> " & vbNewLine
Response.Write " <input type=submit value='下一步' class=button></td>" & vbNewLine
Response.Write "</tr>" & vbNewLine
Response.Write "</form>" & vbNewLine
Response.Write "</table>" & vbNewLine
End Sub
'=================================================
'过程名：ItemStep4
'作 用：项目设置第四步
'=================================================
Private Sub ItemStep4()
Dim RemoteListStr
Dim RemoteListUrl
Dim RemoteHtmlCode
Dim RemoteListCode
Dim RemoteContent
Dim strContentUrl
Dim ContentUrl
Dim HtmlContent
Dim WebSiteUrl
Dim Rs
Dim SQL
If Trim(Request("ItemID")) = "" Then
FoundErr = True
ErrMsg = ErrMsg + "<li>错误的系统参数！</li>"
End If
If FoundErr = True Then Exit Sub
Set Rs = CreateObject("ADODB.Recordset")
SQL = "select * from NC_CollectArticle where id=" & CLng(Request("ItemID"))
Rs.Open SQL, MyConn, 1, 3
If Trim(Request("change")) = "yes" Then
Rs("RemoteListStr") = Request.Form("RemoteListStr0") & "$$$" & Request.Form("RemoteListStr1") & "$$$" & Request.Form("RemoteListStr2") & "$$$" & Request.Form("RemoteListStr3")
Rs.Update
End If
ItemID = Rs("id")
WebSiteUrl = Rs("WebSiteUrl")
RemoteListUrl = Replace(Replace(Rs("RemoteListUrl"), "{$PageCode}", 1, 1, -1, 1), "*", 1)
If Not CheckRemoteUrl(RemoteListUrl) Then
RemoteListUrl = Replace(Replace(Replace(Replace(Rs("RemoteListUrl"), "{$PageCode}", "", 1, -1, 1), "_", ""), "-", ""), "*", "")
If Not CheckRemoteUrl(RemoteListUrl) Then
Dim sHtmlExtName, HtmlExtName, strListUrl, TempListUrl
sHtmlExtName = Split(RemoteListUrl, ".")
HtmlExtName = sHtmlExtName(UBound(sHtmlExtName))
strListUrl = Split(RemoteListUrl, "/")
TempListUrl = strListUrl(UBound(strListUrl))
TempListUrl = Left(RemoteListUrl, Len(RemoteListUrl) - Len(TempListUrl))
RemoteListUrl = TempListUrl & "index." & HtmlExtName
End If
End If
If Not CheckRemoteUrl(RemoteListUrl) Then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -